{-|
Copyright  :  (C) 2013-2016, University of Twente
License    :  BSD2 (see the file LICENSE)
Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>
-}

{-# LANGUAGE TemplateHaskell #-}

{-# LANGUAGE Trustworthy #-}

{-# OPTIONS_HADDOCK show-extensions #-}

module Clash.Promoted.Nat.TH
  ( -- * Declare a single @d\<N\>@ literal
    decLiteralD
    -- * Declare ranges of @d\<N\>@ literals
  , decLiteralsD
  )
where

import Language.Haskell.TH
import Clash.Promoted.Nat

{- $setup
>>> :set -XDataKinds
>>> :m -Prelude
>>> import Clash.Prelude
>>> let d1111 = SNat :: SNat 1111
>>> let d1200 = SNat :: SNat 1200
>>> let d1201 = SNat :: SNat 1201
>>> let d1202 = SNat :: SNat 1202
-}

-- | Create an 'SNat' literal
--
-- > $(decLiteralD 1111)
--
-- >>> :t d1111
-- d1111 :: SNat 1111
--
decLiteralD :: Integer
            -> Q [Dec]
decLiteralD :: Integer -> Q [Dec]
decLiteralD Integer
n = do
  let suffix :: String
suffix  = if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then String -> String
forall a. HasCallStack => String -> a
error (String
"Can't make negative SNat: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n) else Integer -> String
forall a. Show a => a -> String
show Integer
n
      valName :: Name
valName = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Char
'd'Char -> String -> String
forall a. a -> [a] -> [a]
:String
suffix
  Dec
sig   <- Name -> Q Type -> Q Dec
forall (m :: Type -> Type). Quote m => Name -> m Type -> m Dec
sigD Name
valName (Q Type -> Q Type -> Q Type
forall (m :: Type -> Type). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: Type -> Type). Quote m => Name -> m Type
conT ''SNat) (Q TyLit -> Q Type
forall (m :: Type -> Type). Quote m => m TyLit -> m Type
litT (Integer -> Q TyLit
forall (m :: Type -> Type). Quote m => Integer -> m TyLit
numTyLit Integer
n)))
  Dec
val   <- Q Pat -> Q Body -> [Q Dec] -> Q Dec
forall (m :: Type -> Type).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD (Name -> Q Pat
forall (m :: Type -> Type). Quote m => Name -> m Pat
varP Name
valName) (Q Exp -> Q Body
forall (m :: Type -> Type). Quote m => m Exp -> m Body
normalB [| SNat |]) []
  [Dec] -> Q [Dec]
forall a. a -> Q a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [ Dec
sig, Dec
val ]

-- | Create a range of 'SNat' literals
--
-- > $(decLiteralsD 1200 1202)
--
-- >>> :t d1200
-- d1200 :: SNat 1200
-- >>> :t d1201
-- d1201 :: SNat 1201
-- >>> :t d1202
-- d1202 :: SNat 1202
--
decLiteralsD :: Integer
             -> Integer
             -> Q [Dec]
decLiteralsD :: Integer -> Integer -> Q [Dec]
decLiteralsD Integer
from Integer
to =
    ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall a b. (a -> b) -> Q a -> Q b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Dec]] -> [Dec]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat (Q [[Dec]] -> Q [Dec]) -> Q [[Dec]] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [Q [Dec]] -> Q [[Dec]]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence ([Q [Dec]] -> Q [[Dec]]) -> [Q [Dec]] -> Q [[Dec]]
forall a b. (a -> b) -> a -> b
$ [ Integer -> Q [Dec]
decLiteralD Integer
n | Integer
n <- [Integer
from..Integer
to] ]