Expression.hs

module Language.Embedded.VHDL.Monad.Expression
  ( and, or, xor, xnor, nand, nor
  , eq, neq, lt, lte, gt, gte
  , sll, srl, sla, sra, rol, ror
  , add, sub, cat, neg
  , mul, div, mod, rem
  , exp, abs, not
  , name, simple, indexed, selected, slice, attribute
  , literal, number, string
  , aggregate, aggregated, associated, others
  , function
  , qualified
  , cast
  -- utility.
  , resize, asBits, asSigned, asUnsigned, toSigned, toUnsigned, toInteger
  , range, downto, to
  , point, upper, lower, zero
  , choices, is, between
  ) where

import Language.VHDL

import Prelude hiding (and, or, div, mod, rem, exp, abs, not, null, toInteger)

--------------------------------------------------------------------------------
-- * Expressions and their sub-layers.
--------------------------------------------------------------------------------

relation :: RelationalOperator -> ShiftExpression -> ShiftExpression -> Relation
relation r a b = Relation a (Just (r, b))

shiftexp :: ShiftOperator -> SimpleExpression -> SimpleExpression -> ShiftExpression
shiftexp s a b = ShiftExpression a (Just (s, b))

simplexp :: Maybe Sign -> AddingOperator -> [Term] -> SimpleExpression
simplexp s o (a:as) = SimpleExpression s a (fmap ((,) o) as)

term :: MultiplyingOperator -> [Factor] -> Term
term o (a:as) = Term a (fmap ((,) o) as)

--------------------------------------------------------------------------------
-- ** Expressions

and, or, xor, xnor :: [Relation] -> Expression
and  = EAnd  
or   = EOr   
xor  = EXor  
xnor = EXnor

nand, nor :: Relation -> Relation -> Expression
nand a b = ENand a (Just b)
nor  a b = ENor  a (Just b)

--------------------------------------------------------------------------------
-- ** Relations

eq, neq, lt, lte, gt, gte :: ShiftExpression -> ShiftExpression -> Relation
eq  = relation Eq
neq = relation Neq
lt  = relation Lt
lte = relation Lte
gt  = relation Gt
gte = relation Gte

--------------------------------------------------------------------------------
-- ** Shift Expressions

sll, srl, sla, sra, rol, ror :: SimpleExpression -> SimpleExpression -> ShiftExpression
sll = shiftexp Sll
srl = shiftexp Srl
sla = shiftexp Sla
sra = shiftexp Sra
rol = shiftexp Rol
ror = shiftexp Ror

--------------------------------------------------------------------------------
-- ** Simple Expressions

add, sub, cat :: [Term] -> SimpleExpression
add = simplexp Nothing Plus
sub = simplexp Nothing Minus
cat = simplexp Nothing Concat

neg :: Term -> SimpleExpression
neg = simplexp (Just Negation) Plus . (: [])

--------------------------------------------------------------------------------
-- ** Terms

mul, div, mod, rem :: [Factor] -> Term
mul = term Times
div = term Div
mod = term Mod
rem = term Rem

--------------------------------------------------------------------------------
-- ** Factors

exp :: Primary -> Primary -> Factor
exp a b = FacPrim a (Just b)

abs, not :: Primary -> Factor
abs = FacAbs
not = FacNot

--------------------------------------------------------------------------------
-- ** Primaries.

--------------------------------------------------------------------------------
-- *** Names.

name :: Name -> Primary
name = PrimName

simple :: String -> Name
simple = NSimple . Ident

selected :: Name -> Identifier -> Name
selected i s = NSelect $ SelectedName (PName i) (SSimple s)

indexed :: Name -> Expression -> Name
indexed i l = NIndex $ IndexedName (PName i) [l]

slice :: Name -> Range -> Name
slice i r = NSlice $ SliceName (PName i) (DRRange r)

attribute :: String -> Name -> Primary
attribute s n = PrimName $ NAttr $ AttributeName (PName n) Nothing (Ident s) Nothing

--------------------------------------------------------------------------------
-- *** Literals.

literal :: Literal -> Primary
literal = PrimLit

number :: String -> Literal
number = LitNum . NLitPhysical . PhysicalLiteral Nothing . NSimple . Ident

string :: String -> Literal
string = LitString . SLit

--------------------------------------------------------------------------------
-- *** Aggregates.

aggregate :: Aggregate -> Primary
aggregate = PrimAgg

aggregated :: [Expression] -> Aggregate
aggregated = Aggregate . fmap (ElementAssociation Nothing)

associated :: [(Maybe Choices, Expression)] -> Aggregate
associated es = Aggregate $ map (uncurry ElementAssociation) es

others :: Expression -> Aggregate
others = Aggregate . (:[]) . ElementAssociation (Just (Choices [ChoiceOthers]))

--------------------------------------------------------------------------------
-- *** Functions.

function :: Name -> [Expression] -> Primary
function i [] = PrimFun $ FunctionCall i Nothing
function i xs = PrimFun
  . FunctionCall i . Just . AssociationList
  $ fmap (AssociationElement Nothing . APDesignator . ADExpression) xs

--------------------------------------------------------------------------------
-- *** Qualified.

qualified :: SubtypeIndication -> Expression -> Primary
qualified (SubtypeIndication _ t _) = PrimQual . QualExp t

--------------------------------------------------------------------------------
-- *** Type conversion.

cast :: SubtypeIndication -> Expression -> Primary
cast (SubtypeIndication _ t _) = PrimTCon . TypeConversion (unrange t)
  where
    unrange :: TypeMark -> TypeMark
    unrange (TMType (NSlice (SliceName (PName (NSimple (Ident typ))) _))) = TMType (NSimple (Ident typ))
    unrange (TMType (NSimple (Ident typ))) = TMType (NSimple (Ident typ))

--------------------------------------------------------------------------------
-- ...

resize :: Expression -> Expression -> Primary
resize exp size = function (simple "resize") [exp, size]

asBits :: Expression -> Primary
asBits exp = function (simple "std_logic_vector") [exp]

asSigned :: Expression -> Primary
asSigned exp = function (simple "signed") [exp]

asUnsigned :: Expression -> Primary
asUnsigned exp = function (simple "unsigned") [exp]

toSigned :: Expression -> Expression -> Primary
toSigned exp size = function (simple "to_signed") [exp, size]

toUnsigned :: Expression -> Expression -> Primary
toUnsigned exp size = function (simple "to_unsigned") [exp, size]

toInteger :: Expression -> Primary
toInteger exp = function (simple "to_integer") [exp]

--------------------------------------------------------------------------------
-- ...

range :: SimpleExpression -> Direction -> SimpleExpression -> Range
range  = RSimple

downto, to :: Direction
downto = DownTo
to     = To

--------------------------------------------------------------------------------
-- ...

point :: Show i => i -> SimpleExpression
point i = SimpleExpression Nothing (Term (FacPrim (literal (number (show i))) (Nothing)) []) []

upper, lower :: Integer -> SimpleExpression
upper 0 = point 0
upper n = point (n-1)
lower n = point n

zero :: SimpleExpression
zero = point 0

--------------------------------------------------------------------------------
-- ...

choices :: [Choice] -> Choices
choices = Choices

is :: SimpleExpression -> Choice
is = ChoiceSimple

between :: Range -> Choice
between = ChoiceRange . DRRange

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