-- | 
-- Module: Stacks
-- Description: Stream for a stack machine
-- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc.
-- 
-- This is a stream for a stack machine.
--
-- The stack is created from a specified depth, a specified start value, and
-- three input streams:
--
-- * a pop signal which pops off the stack when true,
-- * a push signal which pushes the value from the push stream onto the stack when true,
-- * a push stream.
-- The resultant stream is the top value of the stack.
--
-- In 'stack' the push signal takes priority over the pop signal in the event
-- that both are true in the same tick. This priority is reversed in 'stack''.
-- 
-- Here is an example sequence with one stack of each type, both depth 3 and
-- starting value 0:
--
-- @ 
-- popSignal:   pushSignal:  pushValue:   stack:       stack':     
-- false        true         100          0            0           
-- false        true         101          100          100         
-- true         true         102          101          101         
-- true         false        103          100          102         
-- true         false        104          0            101         
-- true         false        105          0            100         
-- true         false        106          0            0           
-- @
-- 
-- Note the difference at the 4th tick after /popSignal/ and /pushSignal/ were
-- both true.  Note also that one cannot pop the start value off the stack -
-- that is, the stack is never empty.

{-# LANGUAGE NoImplicitPrelude #-}

module Copilot.Library.Stacks
  ( stack, stack' ) where

import Copilot.Language

-- | Stack stream in which the pop signal has precedence over the push signal
-- in case both are true in the same tick
stack :: (Integral a, Typed b) =>
         a              -- ^ Depth
         -> b           -- ^ Start value
         -> Stream Bool -- ^ Pop signal
         -> Stream Bool -- ^ Push signal
         -> Stream b    -- ^ Push stream
         -> Stream b    -- ^ Stack top
stack :: a -> b -> Stream Bool -> Stream Bool -> Stream b -> Stream b
stack a
depth b
startValue
  Stream Bool
popSignal Stream Bool
pushSignal Stream b
pushValue =
  let depth' :: Int
depth'      = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
depth
      startValue' :: Stream b
startValue' = b -> Stream b
forall a. Typed a => a -> Stream a
constant b
startValue
      stackValue :: Stream b -> Stream b -> Stream b
stackValue Stream b
pushValue' Stream b
popValue' =
        let stackValue' :: Stream b
stackValue'  = [ b
startValue ]
                           [b] -> Stream b -> Stream b
forall a. Typed a => [a] -> Stream a -> Stream a
++ Stream Bool -> Stream b -> Stream b -> Stream b
forall a.
Typed a =>
Stream Bool -> Stream a -> Stream a -> Stream a
mux Stream Bool
popSignal
                                  Stream b
popValue'
                                  ( Stream Bool -> Stream b -> Stream b -> Stream b
forall a.
Typed a =>
Stream Bool -> Stream a -> Stream a -> Stream a
mux Stream Bool
pushSignal
                                        Stream b
pushValue'
                                        Stream b
stackValue' )
        in  Stream b
stackValue'
      toStack :: [Stream b -> Stream b -> Stream b] -> Stream b
toStack [Stream b -> Stream b -> Stream b]
l =
        let toStack' :: Stream b -> [Stream b -> Stream b -> Stream b] -> Stream b
toStack' Stream b
_    []           = Stream b
startValue'
            toStack' Stream b
prev ( Stream b -> Stream b -> Stream b
sv : [Stream b -> Stream b -> Stream b]
svs ) =
              let current :: Stream b
current = Stream b -> Stream b -> Stream b
sv Stream b
prev ( Stream b -> [Stream b -> Stream b -> Stream b] -> Stream b
toStack' Stream b
current [Stream b -> Stream b -> Stream b]
svs )
              in  Stream b
current
        in Stream b -> [Stream b -> Stream b -> Stream b] -> Stream b
toStack' Stream b
pushValue [Stream b -> Stream b -> Stream b]
l

   in [Stream b -> Stream b -> Stream b] -> Stream b
toStack ([Stream b -> Stream b -> Stream b] -> Stream b)
-> [Stream b -> Stream b -> Stream b] -> Stream b
forall a b. (a -> b) -> a -> b
$ Int
-> (Stream b -> Stream b -> Stream b)
-> [Stream b -> Stream b -> Stream b]
forall a. Int -> a -> [a]
replicate Int
depth' Stream b -> Stream b -> Stream b
stackValue

-- | Stack stream in which the push signal has precedence over the pop signal
-- in case both are true in the same tick
stack' :: (Integral a, Typed b) =>
         a              -- ^ Depth
         -> b           -- ^ Start value
         -> Stream Bool -- ^ Pop signal
         -> Stream Bool -- ^ Push signal
         -> Stream b    -- ^ Push stream
         -> Stream b    -- ^ Stack top
stack' :: a -> b -> Stream Bool -> Stream Bool -> Stream b -> Stream b
stack' a
depth b
startValue
  Stream Bool
popSignal Stream Bool
pushSignal Stream b
pushValue =
  let depth' :: Int
depth'      = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
depth
      startValue' :: Stream b
startValue' = b -> Stream b
forall a. Typed a => a -> Stream a
constant b
startValue
      stackValue :: Stream b -> Stream b -> Stream b
stackValue Stream b
pushValue' Stream b
popValue' =
        let stackValue' :: Stream b
stackValue'  = [ b
startValue ]
                           [b] -> Stream b -> Stream b
forall a. Typed a => [a] -> Stream a -> Stream a
++ Stream Bool -> Stream b -> Stream b -> Stream b
forall a.
Typed a =>
Stream Bool -> Stream a -> Stream a -> Stream a
mux Stream Bool
pushSignal
                                  Stream b
pushValue'
                                  ( Stream Bool -> Stream b -> Stream b -> Stream b
forall a.
Typed a =>
Stream Bool -> Stream a -> Stream a -> Stream a
mux Stream Bool
popSignal
                                        Stream b
popValue'
                                        Stream b
stackValue' )
        in  Stream b
stackValue'
      toStack :: [Stream b -> Stream b -> Stream b] -> Stream b
toStack [Stream b -> Stream b -> Stream b]
l =
        let toStack' :: Stream b -> [Stream b -> Stream b -> Stream b] -> Stream b
toStack' Stream b
_    []           = Stream b
startValue'
            toStack' Stream b
prev ( Stream b -> Stream b -> Stream b
sv : [Stream b -> Stream b -> Stream b]
svs ) =
              let current :: Stream b
current = Stream b -> Stream b -> Stream b
sv Stream b
prev ( Stream b -> [Stream b -> Stream b -> Stream b] -> Stream b
toStack' Stream b
current [Stream b -> Stream b -> Stream b]
svs )
              in  Stream b
current
        in Stream b -> [Stream b -> Stream b -> Stream b] -> Stream b
toStack' Stream b
pushValue [Stream b -> Stream b -> Stream b]
l

   in [Stream b -> Stream b -> Stream b] -> Stream b
toStack ([Stream b -> Stream b -> Stream b] -> Stream b)
-> [Stream b -> Stream b -> Stream b] -> Stream b
forall a b. (a -> b) -> a -> b
$ Int
-> (Stream b -> Stream b -> Stream b)
-> [Stream b -> Stream b -> Stream b]
forall a. Int -> a -> [a]
replicate Int
depth' Stream b -> Stream b -> Stream b
stackValue