fp1/week3/mart/StdStack.icl

   1 implementation module StdStack
   2
   3 import StdEnv
   4
   5 :: Stack a = Stack [a]
   6
   7 newStack :: Stack a
   8 newStack = Stack []
   9
  10 push     ::  a  (Stack a) -> Stack a
  11 push x (Stack xs) = Stack [x:xs]
  12
  13 pushes   :: [a] (Stack a) -> Stack a
  14 pushes [] (Stack s) = Stack s
  15 pushes [x:xs] (Stack s) = pushes xs (push x (Stack s))
  16
  17 pop      ::     (Stack a) -> Stack a
  18 pop (Stack []) = abort "Can't pop from empty stack..."
  19 pop (Stack [x:xs]) = Stack xs
  20
  21 popn     :: Int (Stack a) -> Stack a
  22 popn 0 s = s
  23 popn n s = popn (n-1) (pop s)
  24
  25 top      ::     (Stack a) -> a
  26 top (Stack []) = abort "Can't give top of empty stack..."
  27 top (Stack [x:_]) = x
  28
  29 topn     :: Int (Stack a) -> [a]
  30 topn 0 _ = []
  31 topn n x = [top x:topn (n-1) (pop x)]
  32
  33 elements ::     (Stack a) -> [a]
  34 elements (Stack s) = s
  35
  36 count    ::     (Stack a) -> Int
  37 count (Stack []) = 0
  38 count (Stack [_:xs]) = 1 + count (Stack xs)
  39
  40 Start  = ( "s0 = newStack = ",        s0,'\n'
  41          , "s1 = push 1 s0 = ",       s1,'\n'
  42          , "s2 = pushes [2..5] s1 = ",s2,'\n'
  43          , "s3 = pop s2 = ",          s3,'\n'
  44          , "s4 = popn 3 s3 = ",       s4,'\n'
  45          , "s5 = top s4 = ",          s5,'\n'
  46          , "s6 = topn 3 s2 = ",       s6,'\n'
  47          , "s7 = elements s2 = ",     s7,'\n'
  48          )
  49 where
  50         s0 = newStack
  51         s1 = push 1 s0
  52         s2 = pushes [2..5] s1
  53         s3 = pop s2
  54         s4 = popn 3 s3
  55         s5 = top s4
  56         s6 = topn 3 s2
  57         s7 = elements s2