Living in the open world(2)

以下は Alice が定義：

{-# LANGUAGE TypeSynonymInstances #-}

module A where

type StackA = []

top :: StackA a -> a
top = head

pop :: StackA a -> StackA a
pop = tail

push :: a -> StackA a -> StackA a
push = (:)

move :: StackA a -> c a -> (a -> c a -> c a) -> (StackA a, c a)
move s1 s2 fpush = (s1',s2')
  where
    x = top s1
    s1' = pop s1
    s2' = fpush x s2

以下は Bob が定義：

module B where
data StackB a = Nil | Cons a (StackB a) deriving Show

top :: StackB a -> a
top (Cons x _) = x

pop :: StackB a -> StackB a
pop (Cons x s) = s

push :: a -> StackB a -> StackB a
push x s = Cons x s

move :: StackB a -> c a -> (a -> c a -> c a) -> (StackB a, c a)
move s1 s2 fpush = (s1',s2')
  where
    x = top s1
    s1' = pop s1
    s2' = fpush x s2

以下は Chris が定義：

module C where

import A (StackA(..))
import qualified A hiding (StackA)
import B (StackB(..))
import qualified B hiding (StackB)

class Stack s where
    top :: s a -> a
    pop :: s a -> s a
    push :: a -> s a -> s a
    move :: s a -> c a -> (a -> c a -> c a) -> (s a, c a)

instance Stack StackA where
    top = A.top
    pop = A.pop
    push = A.push
    move = A.move

instance Stack StackB where
    top = B.top
    pop = B.pop
    push = B.push
    move = B.move

動かす。

move (Cons 1 Nil) [] A.push
→ (Nil,[1])
move [1] Nil B.push
→ ([],Cons 1 Nil)