-- |
-- Module: Clocks
-- Description: Clocks based on a base period and phase
-- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc.
--
-- This library generates new clocks based on a base period and phase.
--
-- = Example Usage
--
-- Also see @examples/Clock.hs@ in the
-- <https://github.com/Copilot-Language/copilot/blob/master/copilot/examples/ Copilot repository>.
--
-- @
--     'clk' ( 'period' 3 ) ( 'phase' 1 )
-- @
--
-- is equivalent to a stream of values like:
--
-- @
--     cycle [False, True, False]
-- @
--
-- that generates a stream of values
--
-- @
--     False True False False True False False True False ...
--     0     1    2     3     4    5     6     7    8
-- @
--
-- That is true every 3 ticks (the period) starting on the 1st tick (the phase).

{-# LANGUAGE NoImplicitPrelude #-}

module Copilot.Library.Clocks
  ( clk, clk1, period, phase ) where

import Prelude ()
import qualified Prelude as P
import Copilot.Language

data ( Integral a ) => Period a = Period a
data ( Integral a ) => Phase  a = Phase  a

-- | Constructor for a 'Period'. Note that period must be greater than 0.
period :: ( Integral a ) => a -> Period a
period :: forall a. Integral a => a -> Period a
period = forall a. a -> Period a
Period

-- | Constructor for a 'Phase'. Note that phase must be greater than or equal
-- to 0, and must be less than the period.
phase :: ( Integral a ) => a -> Phase a
phase :: forall a. Integral a => a -> Phase a
phase  = forall a. a -> Phase a
Phase

-- | Generate a clock that counts every @n@ ticks, starting at tick @m@, by
-- using an array of size @n@.
clk :: ( Integral a ) =>
       Period a       -- ^ Period @n@ of clock
       -> Phase a     -- ^ Phase @m@ of clock
       -> Stream Bool -- ^ Clock signal - 'True' on clock ticks, 'False' otherwise
clk :: forall a. Integral a => Period a -> Phase a -> Stream Bool
clk ( Period a
period' ) ( Phase a
phase' ) = Stream Bool
clk'
  where
    clk' :: Stream Bool
clk' = if a
period' forall a. Ord a => a -> a -> Bool
P.< a
1 then
               forall a. String -> a
badUsage ( String
"clk: clock period must be 1 or greater" )
           else if a
phase' forall a. Ord a => a -> a -> Bool
P.< a
0 then
                    forall a. String -> a
badUsage ( String
"clk: clock phase must be 0 or greater" )
                else if a
phase' forall a. Ord a => a -> a -> Bool
P.>= a
period' then
                         forall a. String -> a
badUsage ( String
"clk: clock phase must be less than period")
                     else forall a. Int -> a -> [a]
replicate ( forall a b. (Integral a, Num b) => a -> b
fromIntegral a
phase' ) Bool
False
                          forall a. [a] -> [a] -> [a]
P.++ Bool
True forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate
                               ( forall a b. (Integral a, Num b) => a -> b
fromIntegral
                                 forall a b. (a -> b) -> a -> b
$ a
period' forall a. Num a => a -> a -> a
P.- a
phase' forall a. Num a => a -> a -> a
P.- a
1 ) Bool
False
                               forall a. Typed a => [a] -> Stream a -> Stream a
++ Stream Bool
clk'

-- | This follows the same convention as 'clk', but uses a counter variable of
-- integral type /a/ rather than an array.
clk1 :: ( Integral a, Typed a ) =>
        Period a       -- ^ Period @n@ of clock
        -> Phase a     -- ^ Phase @m@ of clock
        -> Stream Bool -- ^ Clock signal - 'True' on clock ticks, 'False' otherwise
clk1 :: forall a.
(Integral a, Typed a) =>
Period a -> Phase a -> Stream Bool
clk1 ( Period a
period' ) ( Phase a
phase' ) =
    if a
period' forall a. Ord a => a -> a -> Bool
P.< a
1 then
        forall a. String -> a
badUsage ( String
"clk1: clock period must be 1 or greater" )
    else if a
phase' forall a. Ord a => a -> a -> Bool
P.< a
0 then
             forall a. String -> a
badUsage ( String
"clk1: clock phase must be 0 or greater" )
         else if a
phase' forall a. Ord a => a -> a -> Bool
P.>= a
period' then
                  forall a. String -> a
badUsage ( String
"clk1: clock phase must be less than period")
              else
                  let counter :: Stream a
counter = [ forall a. Num a => Integer -> a
P.fromInteger Integer
0 ]
                                forall a. Typed a => [a] -> Stream a -> Stream a
++ forall a.
Typed a =>
Stream Bool -> Stream a -> Stream a -> Stream a
mux ( Stream a
counter forall a. (Eq a, Typed a) => Stream a -> Stream a -> Stream Bool
/= ( forall a. Typed a => a -> Stream a
constant forall a b. (a -> b) -> a -> b
$
                                                        a
period' forall a. Num a => a -> a -> a
P.- a
1 ) )
                                       ( Stream a
counter forall a. Num a => a -> a -> a
P.+ Stream a
1 )
                                       ( Stream a
0 )
                  in Stream a
counter forall a. (Eq a, Typed a) => Stream a -> Stream a -> Stream Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral a
phase'