Детская болезнь "эмелизны" в хаскелизме.

modles.md

Детская болезнь "эмелизны" в хаскелизме.

Приближается, пожалуй, самое значительное нововведение в хаскеле, со времен FC и превращения хаскеля из ML++ в недоΩmega: модули. Весь этот тектонический сдвиг, правда, остается незамеченным. Даже в Release notes об этом не упомянуто. Есть, только упоминание в руководстве пользователя Также, описания новой системы модулей можно найти на странице Backpack, но установить что из этого уже имплементировано можно только опытным путем.

Представление о ML-модулях можно составить из диссертации Дрейера (pdf)

Рассмотрим наивную имплементацию множества c помощью SML и Backpack модулей.

Вот сигнатура и реализация для Int компаратора:

signature OrdSig = sig
    type t
    val cmp : t -> t -> order
end;

-- OrdSig.hsig
module OrdSig where
data T
cmp :: T -> T -> Ordering

structure IntOrd =
struct
    type t = int
    fun cmp x y = Int.compare(x,y)
end;

-- IntOrd.hs
module IntOrd where
newtype T = T { unT :: Int }
cmp (T x) (T y) = compare x y

А вот сигнатура и имплементация самого контейнера:

signature SetSig =
sig
    include OrdSig (* эта связь сигнатур на самом деле не нужна *)
    type 't stype
    val empty : t stype
    val add : t -> t stype -> t stype
    val remove : t -> t stype -> t stype
    val contains : t -> t stype -> bool
    val toList : t stype -> t list
end;

-- SetSig.hsig
module SetSig where
import OrdSig -- пришлось включить, имена типов должны совпадать
data Stype
-- способов указать что один тип равен другому нет.

empty :: Stype
add :: T -> Stype -> Stype
remove :: T -> Stype -> Stype
contains :: T -> Stype -> Bool
toList :: Stype a -> [a]

functor NaiveSet (Ord:OrdSig) : SetSig = 
struct
    open List
    open Ord
    type 't stype = 't list
    val empty = []
    fun remove el els = filter (fn x => cmp el x <> EQUAL) els
    fun contains el els = exists (fn x => cmp el x = EQUAL) els
    fun add el els = if (contains el els) then els else (el :: els)
    fun toList els = els
end;

module NaiveSet where
import OrdSig -- импорт сигнатуры - аналог параметра функтора

-- абстракция типа в SML ничего не стоит для программиста, здесь же придется
-- вручную паковать/распаковывать ньютайпы (впрочем, если имя типа подходящее - это не нужно).
newtype Stype = Stype [T]

empty :: Stype
empty = Stype []

remove :: T -> Stype -> Stype
remove el (Stype els) = Stype $ filter (\x -> cmp el x /= EQ) els

contains :: T -> Stype -> Bool
contains el (Stype els) = any (\x -> cmp el x == EQ) els

add :: T -> Stype -> Stype
add el els@(Stype ls) = if (contains el els) then els else Stype (el : ls)

toList :: Stype -> [T]
toList (Stype els) = els

В SML можно на месте применения решать будет ли тип абстрактным или нет:

(* transparent *)
structure Set = NaiveSet(IntOrd);

(* список остался списком, Set.stype - аналог type instance *)
- let open Set in (remove 10 o add 3 o add 10) empty end;
val it = [3] : Set.stype

(* opaque ascription *)
structure NewSet = NaiveSet(IntOrd) :> SetSig where type t = int;

(* теперь множество - абстрактный тип, c ним только через сигнатруру S работать можно *)
- let open NewSet in (remove 10 o add 3 o add 10) empty end;
val it = - : NewSet.stype

- let open NewSet in (toList o remove 10 o add 3 o add 10) empty end;
val it = [3] : NewSet.elt list

Backpack же такого выбора не предоставляет.

import SetSig -- аналог параметра функтора
import IntOrd -- аналога where type t = int нет - нужно импортировать конструкторы
              -- и паковать/распаковывать вручную.

main = print . map unT . toList . remove (T 10) . add (T 3) . add (T 10) $ empty

Тут начинается самое веселье - в настоящий момент никакого синтаксиса для применения модулей в хаскеле нет. Это нужно делать при помощи ключей команды ghc во время компиляции.

ghc -c IntOrd.hs
ghc -c OrdSig.hsig -sig-of main:IntOrd
ghc -c NaiveSet.hs
ghc -c SetSig.hsig -sig-of main:NaiveSet
ghc -c Main.hs

Теперь линкуем:

ghc Main.o IntOrd.o NaiveSet.o

Получить аналог transparent кода и развязать модули можно с помощью type families

-- OrdSig.hsig
{-# LANGUAGE TypeFamilies #-}

module OrdSig where

type family T
cmp :: T -> T -> Ordering

-- IntOrd.hs
{-# LANGUAGE TypeFamilies #-}

module IntOrd where

type family T
type instance T = Int -- инстанс "протекает" через сигнатуру, 
-- его упоминание в ней не требуется 

cmp :: T -> T -> Ordering
cmp = compare

Сигнатура "отвязанная" от OrdSig

signature SetSig =
sig
    type elt
    type stype
    val empty : stype
    val add : elt -> stype -> stype
    val remove : elt -> stype -> stype
    val contains : elt -> stype -> bool
    val toList : stype -> elt list
end;

-- SetSig.hsig
{-# LANGUAGE TypeFamilies #-}

module SetSig where

data Stype
type family Elt
empty :: Stype
add :: Elt -> Stype -> Stype
remove :: Elt -> Stype -> Stype
contains :: Elt -> Stype -> Bool
toList :: Stype -> [Elt]

functor NaiveSet (Ord:OrdSig) : SetSig =
struct
    open List
    open Ord
    type elt = t
    type stype = elt list
    val empty = []
    fun remove el els = filter (fn x => cmp el x <> EQUAL) els
    fun contains el els = exists (fn x => cmp el x = EQUAL) els
    fun add el els = if (contains el els) then els else (el :: els)
    fun toList els = els
end;

-- NaiveSet.hs
{-# LANGUAGE TypeFamilies, UndecidableInstances #-}

module NaiveSet where
import OrdSig

type family Elt
type instance Elt = T -- T - семейство, так что UndecidableInstances
newtype Stype = Stype [Elt]

empty :: Stype
empty = Stype []

-- алгоритм сопоставления модуля и сигнатуры крайне тупой, так что эти
-- аннотации типов обязательны
remove :: Elt -> Stype -> Stype
remove el (Stype els) = Stype $ filter (\x -> cmp el x /= EQ) els

contains :: Elt -> Stype -> Bool
contains el (Stype els) = any (\x -> cmp el x == EQ) els

add :: Elt -> Stype -> Stype
add el els@(Stype ls) = if (contains el els) then els else Stype (el : ls)

toList :: Stype -> [Elt]
toList (Stype els) = els

import SetSig

main = print . toList . remove 3 . add 3 . add 10 . add 5 $ empty

Все эти муки с прозрачным запечатыванием в хаскеле, правда, не особенно нужны - в нем тайпклассы есть.

В следующий раз мы поэкспериментируем с экспериментальной веткой GHC в которой имплементация модулей продвинулась дальше.