Literal.hs

{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveTraversable #-}

{-
Module      :  $Header$
Description :  CAO language literals
Copyright   :  (c) SMART Team / HASLab
License     :  GPL

Maintainer  :  Paulo Silva <paufil@di.uminho.pt>
Stability   :  experimental
Portability :  non-portable

-}

module Language.CAO.Common.Literal where

import Data.Foldable                  (Foldable)
import Data.Traversable               (Traversable)

import Language.CAO.Common.Outputable
import Language.CAO.Common.Representation
import Language.CAO.Common.Polynomial

import Language.CAO.Semantics.Bits (bitsToString)

-- | Bit strings are stored in the reversed order. 
data Literal id
    -- | Boolean literals
    = BLit !Bool
    -- | Integer literals
    | ILit !Integer
    -- | Bit strings
    | BSLit !Sign ![Bool]
    -- | Polynomial literals
    | PLit !(Pol id)
    deriving (Show, Read, Functor, Foldable, Traversable, Eq, Ord)

instance PP id => PP (Literal id) where
    ppr = pprLit

pprLit :: PP id => Literal id -> CDoc
pprLit (BLit True)   = text "true"
pprLit (BLit False)  = text "false"
pprLit (ILit i)      = integer i
pprLit (BSLit sig s) = text (signPrefix sig) <> text (bitsToString s)
pprLit (PLit p)      = brackets $ ppr p

instance PP id => StringRepresentation (Literal id) where
    toString (ILit i) = intString i
    toString (PLit p) = toString p
    toString l        = showPpr l

--------------------------------------------------------------------------------
-- | Signal of a bit string
data Sign
    = U -- ^ Unsigned 
    | S -- ^ Signed
    deriving (Show, Read, Eq, Ord)

instance PP Sign where
    ppr U = text "unsigned"
    ppr S = text "signed"

signPrefix :: Sign -> String
signPrefix s = case s of
    U -> "0b"
    S -> "1b"