{-# LANGUAGE BangPatterns #-} module Language.ArrayForth.Stack (empty, push, pop, fill, Stack) where import Prelude hiding ((++)) import Data.List (foldl') import Data.Vector.Unboxed ((!), (++)) import qualified Data.Vector.Unboxed as V import Language.ArrayForth.Opcode (F18Word) newtype Stack = Stack (V.Vector Int) deriving (Eq) instance Show Stack where show (Stack body) = unwords . map show $ V.toList body -- | A stack containing only 0s. empty :: Stack empty = Stack $ V.replicate 8 0 -- | Pushes the given element on top of the stack, discarding the last element. push :: Stack -> F18Word -> Stack push !(Stack body) word = Stack . V.cons (fromIntegral word) $ V.init body -- | Pops the top of the stack, returning the value and the new stack. pop :: Stack -> (Stack, F18Word) pop !(Stack body) = let x = V.take 1 body in (Stack $ V.tail body ++ x, fromIntegral $ x ! 0) -- | Push the given elements onto the stack one-by-one. fill :: Stack -> [F18Word] -> Stack fill = foldl' push