Общий «бестиповый» STack в Haskell

Вам нужно, чтобы он был нетипизированным? Если вы хотите использовать расширенные функции GHC, вы можете сделать что-то вроде этого:

{-# LANGUAGE GADTs, DataKinds, KindSignatures, TypeOperators #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}

module Stack (Stack(..), push, pop, top, empty) where

data Stack (h :: [*]) where
    Empty :: Stack '[]
    Push :: x -> Stack xs -> Stack (x ': xs)

instance Show (Stack '[]) where
    showsPrec d Empty = showParen (d > 11) $ showString "Empty"

instance (Show x, Show (Stack xs)) => Show (Stack (x ': xs)) where
    showsPrec d (Push x xs) = showParen (d > 10) $
        showString "Push " . showsPrec 11 x . showChar ' ' . showsPrec 11 xs

instance Eq (Stack '[]) where
    _ == _ = True

instance (Eq x, Eq (Stack xs)) => Eq (Stack (x ': xs)) where
    (Push x xs) == (Push y ys) = x == y && xs == ys

instance Ord (Stack '[]) where
    compare _ _ = EQ

instance (Ord x, Ord (Stack xs)) => Ord (Stack (x ': xs)) where
    compare (Push x xs) (Push y ys) = case compare x y of
    EQ -> compare xs ys
    LT -> LT
    GT -> GT


push :: x -> Stack xs -> Stack (x ': xs)
push = Push

pop :: Stack (x ': xs) -> Stack xs
pop (Push _ xs) = xs

top :: Stack (x ': xs) -> x
top (Push x _) = x

empty :: Stack '[]
empty = Empty

Несколько применений в ghci выглядят так:

[1 of 1] Compiling Stack            ( typelist.hs, interpreted )
Ok, modules loaded: Stack.
*Stack> :t push True . push (Just 'X') . push 5 . push "nil" $ empty
push True . push (Just 'X') . push 5 . push "nil" $ empty
  :: Num x => Stack '[Bool, Maybe Char, x, [Char]]
*Stack> push True . push (Just 'X') . push 5 . push "nil" $ empty
Push True (Push (Just 'X') (Push 5 (Push "nil" Empty)))
*Stack> pop . push True . push (Just 'X') . push 5 . push "nil" $ empty
Push (Just 'X') (Push 5 (Push "nil" Empty))
*Stack> pop empty

<interactive>:75:5:
    Couldn't match type ‘'[]’ with ‘x0 : xs’
    Expected type: Stack (x0 : xs)
      Actual type: Stack '[]
    Relevant bindings include
      it :: Stack xs (bound at <interactive>:75:1)
    In the first argument of ‘pop’, namely ‘empty’
    In the expression: pop empty

Обратите внимание, что это представление имеет приятную особенность: вызов pop или top в пустом стеке вызывает ошибку времени компиляции. Однако с ним немного сложнее работать, поскольку вам всегда нужно доказывать, что вы вызываете его с непустым стеком. Это хорошо для предотвращения ошибок, но иногда требуется дополнительная отчетность, чтобы убедить компилятор в том, что вы все сделали правильно. Не факт, что это представление является хорошим выбором. Это зависит от варианта использования.

У вас не должно быть возможности определить pop для пустого кортежа, но все остальное достаточно гладко, если мы используем класс типов для представления случаев в типе стека.

class Stack h where
  push :: a -> h x -> h (a, x)
  pop :: h (a, x) -> (h x, a)
  top :: h (a, x) -> (h (a, x), a)
  top hax = let (_, a) = pop hax in (hax, a)

newtype S x = S x

instance Stack S where
  push a (S x) = S (a, x)
  pop (S (a, x)) = (S x, a)

Если вы выставляете push/pop/top и S абстрактно вместе с

sempty :: S ()
sempty = S ()

Вы можете гарантировать, что никто не сможет построить патологические стеки. Если у вас все в порядке с GADT, то есть более приятные кодировки.

data S h where
  Nil :: S ()
  Cons :: a -> S x -> S (a, x)

Вы можете открыть этот GADT напрямую, так как он уже не может иметь нарушения типа.

instance Stack S where
  push = Cons
  pop (Cons a x) = (x, a)