fork download 
  1. data Stack a = S (Queue a) (Queue a) deriving (Show)
  2.  
  3. newStack = S newQueue newQueue
  4.  
  5. pop :: Stack a -> (a, Stack a)
  6. pop (S main help) = if empty main
  7.                       then error "Empty stack"
  8.                       else (x, S newMain help)
  9.    where (x, newMain) = deq main
  10.  
  11. push :: a -> Stack a -> Stack a
  12. push a (S main help) = S newMain help
  13.    where newHelp = move main help  --move items from main queue to help queue
  14.          newTop  = enq a newQueue  --enqueue the item to be pushed to an empty queue
  15.          newMain = move newHelp newTop --move items from help queue to the queue with the pushed item
  16.  
  17. -- helper function to move the contents of q1 to q2
  18. move :: Queue a -> Queue a -> Queue a
  19. move q1 q2 = if empty q1
  20.                 then q2
  21.                 else move newQ1 (enq x q2)
  22.    where (x, newQ1) = deq q1
  23.  
  24.  
  25. main :: IO ()
  26. main = do
  27.        let testStack = push 1 $ push 2 $ push 3 newStack
  28.        print testStack
  29.        let popped = snd $ pop testStack
  30.        print popped
  31.        print $ push 10 $ push 20 popped
  32.  
  33.  
  34.  
  35. -- This implementation is taken from 
  36. -- http://w...content-available-to-author-only...s.net/2007/02/08/haskell-queues-without-pointers/
  37. -- except showQueue
  38.  
  39. data Queue a = Queue [a] [a]
  40. newQueue = Queue [] []
  41.  
  42. empty (Queue [] []) = True
  43. empty _             = False
  44.  
  45. enq :: a -> Queue a -> Queue a
  46. enq y (Queue xs ys) = Queue xs (y:ys)
  47.  
  48. deq :: Queue a -> (a, Queue a)
  49. deq (Queue [] []) =
  50.   error "Can't deq from an empty queue"
  51. -- If there's at least one item in the front
  52. -- part of the queue, return it.
  53. deq (Queue (x:xs) ys) = (x, Queue xs ys)
  54. -- If the front part is empty, reverse the
  55. -- back part, move it to the front, and try
  56. -- again.
  57. deq (Queue [] ys) =
  58.   deq (Queue (reverse ys) [])
  59.  
  60. showQueue :: (Show a) => Queue a -> String
  61. showQueue (Queue [] []) = "Q:[]"
  62. showQueue (Queue [] ys) = "Q:" ++ (show $ reverse ys)
  63. showQueue (Queue xs ys) = "Q:" ++ (show $ xs ++ ys)
  64.  
  65. instance (Show a) => Show (Queue a) where
  66.   show = showQueue
Success #stdin #stdout 0s 6280KB
comments (?)
stdin 
Standard input is empty
stdout 
S Q:[1,2,3] Q:[]
S Q:[2,3] Q:[]
S Q:[10,20,2,3] Q:[]
https://ideone.com/xw5iZY
language:
Haskell (ghc 8.4.4)
created:
10 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!