Можно ли получить `- =` работу с литералами?

Сегодня я нашел этот пост в Quora, в котором утверждалось, что

factorial(n) = def $ do    
    assert (n<=0) "Negative factorial"    
    ret <- var 1    
    i <- var n    
    while i $ do    
        ret *= i    
        i -= 1
    return ret

может быть правильным кодом Haskell. Мне стало любопытно, и закончил с

factorial :: Integer -> Integer
factorial n = def $ do
  assert (n >= 0) "Negative factorial"
  ret <- var 1
  i   <- var n
  while i $ do
      ret *= i
      i   -= 1
  return ret

используя var = newSTRef, канонические определения для def, assert и while и

a *= b = readSTRef b >>= \b -> modifySTRef a ((*) b)
a -= b = modifySTRef a ((+) (negate b))

Однако (*=) и (-=) имеют разные типы:

(-=) :: Num a => STRef s a -> a -> ST s ()
(*=) :: Num a => STRef s a -> STRef s a -> ST s ()

Так что ret -= i не работает. Я попытался создать подходящий тип класса для этого:

class (Monad m) => NumMod l r m where
  (+=) :: l -> r -> m ()
  (-=) :: l -> r -> m ()
  (*=) :: l -> r -> m ()

instance Num a => NumMod (STRef s a) (STRef s a) (ST s) where
  a += b    = readSTRef b >>= \b -> modifySTRef a ((+) b)
  a -= b    = readSTRef b >>= \b -> modifySTRef a ((+) (negate b))
  a *= b    = readSTRef b >>= \b -> modifySTRef a ((*) b)

instance (Num a) => NumMod (STRef s a) a (ST s) where
  a += b    = modifySTRef a ((+) (b))
  a -= b    = modifySTRef a ((+) (negate b))
  a *= b    = modifySTRef a ((*) (b))

Это действительно работает, но только до тех пор, пока factorial возвращает Integer. Как только я меняю тип возврата на что-то еще, он терпит неудачу. Я попытался создать еще один экземпляр

instance (Num a, Integral b) => NumMod (STRef s a) b (ST s) where
  a += b    = modifySTRef a ((+) (fromIntegral $ b))
  a -= b    = modifySTRef a ((+) (negate . fromIntegral $ b))
  a *= b    = modifySTRef a ((*) (fromIntegral b))

который выходит из строя из-за перекрывающихся экземпляров.

Можно ли создать подходящее typeclass и экземпляры для запуска factorial для любого Integral a? Или эта проблема всегда будет возникать?

Ответы

Ответ 1

Идея

Идея проста: оберните STRef s a в новый тип данных и сделайте его экземпляром Num.

Решение

Во-первых, нам понадобится только одна прагма:

{-# LANGUAGE RankNTypes #-}

import Data.STRef    (STRef, newSTRef, readSTRef, modifySTRef)
import Control.Monad (when)
import Control.Monad.ST (ST, runST)

Обертка для STRef:

data MyRef s a
  = MySTRef (STRef s a)  -- reference (can modify)
  | MyVal a              -- pure value (modifications are ignored)

instance Num a => Num (MyRef s a) where
  fromInteger = MyVal . fromInteger

Несколько помощников для MyRef напоминают функции STRef:

newMyRef :: a -> ST s (MyRef s a)
newMyRef x = do
  ref <- newSTRef x
  return (MySTRef ref)

readMyRef :: MyRef s a -> ST s a
readMyRef (MySTRef x) = readSTRef x
readMyRef (MyVal   x) = return x

Я хотел бы реализовать -= и *= с помощью более общего помощника alter:

alter :: (a -> a -> a) -> MyRef s a -> MyRef s a -> ST s ()
alter f (MySTRef x) (MySTRef y) = readSTRef y >>= modifySTRef x . flip f
alter f (MySTRef x) (MyVal   y) = modifySTRef x (flip f y)
alter _ _ _ = return ()

(-=) :: Num a => MyRef s a -> MyRef s a -> ST s ()
(-=) = alter (-)

(*=) :: Num a => MyRef s a -> MyRef s a -> ST s ()
(*=) = alter (*)

Другие функции практически не изменяются:

var :: a -> ST s (MyRef s a)
var = newMyRef

def :: (forall s. ST s (MyRef s a)) -> a
def m = runST $ m >>= readMyRef

while :: (Num a, Ord a) => MyRef s a -> ST s () -> ST s ()
while i m = go
  where
    go = do
      n <- readMyRef i
      when (n > 0) $ m >> go

assert :: Monad m => Bool -> String -> m ()
assert b str = when (not b) $ error str

factorial :: Integral a => a -> a
factorial n = def $ do
    assert (n >= 0) "Negative factorial"
    ret <- var 1
    i   <- var n
    while i $ do
      ret *= i
      i -= 1
    return ret

main :: IO ()
main = print . factorial $ 1000

Обсуждение

Создание таких экземпляров Num кажется немного взломанным, но у нас нет класса типа FromInteger в Haskell, поэтому я думаю, что это нормально.

Еще одна зудящая вещь - 3 *= 10, которая return (). Я думаю, что можно использовать тип phantom, чтобы указать, является ли MyRef ST или чистым, и разрешить только ST в LHS alter.