haskell - Haskell 中的多态场景

Question

我编写了以下 Haskell 程序来解释基本数学。除了数学运算符之外，我还想添加比较和 bool 运算符。我的问题是我应该如何用可以处理 Int 或 Bool 的内容替换 Int 的出现。

我考虑将 Token 类型扩展为具有三种类型的运算符，它们仅在函数类型上有所不同 ((Int -> Int -> Int) 、(Int -> Int -> Bool) 和 (Bool -> Bool -> Bool)，但这似乎会导致相当多的重复，在类型声明和模式匹配中。有没有办法用类型类来做到这一点？

type Precedence = Int
data Associativity = AssocL | AssocR
data Token = Operand Int | Operator String (Int -> Int -> Int) Associativity Precedence | ParenL | ParenR

instance Eq Token where
  Operator s1 _ _ _ == Operator s2 _ _ _  = s1 == s2
  Operand  x1       == Operand  x2        = x1 == x2
  ParenL            == ParenL             = True
  ParenR            == ParenR             = True
  _                 == _                  = False

evalMath :: String -> Int
evalMath = rpn . shuntingYard . tokenize

tokenize :: String -> [Token]
tokenize = map token . words
  where token s@"+" = Operator s (+) AssocL 2
        token s@"-" = Operator s (-) AssocL 2
        token s@"*" = Operator s (*) AssocL 3
        token s@"/" = Operator s div AssocL 3
        token s@"^" = Operator s (^) AssocR 4
        token "("   = ParenL
        token ")"   = ParenR
        token x     = Operand $ read x

shuntingYard :: [Token] -> [Token]
shuntingYard = finish . foldl shunt ([], [])
  where finish (tokens, ops) = (reverse tokens) ++ ops
        shunt (tokens, ops) token@(Operand _)        = (token:tokens, ops)
        shunt (tokens, ops) token@(Operator _ _ _ _) = ((reverse higher) ++ tokens, token:lower)
          where (higher, lower) = span (higherPrecedence token) ops
                higherPrecedence (Operator _ _ AssocL prec1) (Operator _ _ _ prec2) = prec1 <= prec2
                higherPrecedence (Operator _ _ AssocR prec1) (Operator _ _ _ prec2) = prec1 < prec2
                higherPrecedence (Operator _ _ _ _)          ParenL                 = False
        shunt (tokens, ops) ParenL = (tokens, ParenL:ops)
        shunt (tokens, ops) ParenR = ((reverse afterParen) ++ tokens, tail beforeParen)
          where (afterParen, beforeParen) = break (== ParenL) ops

rpn :: [Token] -> Int
rpn = head . foldl rpn' []
  where rpn' (x:y:ys) (Operator _ f _ _) = (f x y):ys
        rpn' xs (Operand x) = x:xs

Answer 1

这绝对是一项先进的技术，但您可以使用类型类和 GADT 将临时多态性提升到 DSL，并获得类型标记作为结果(即，您无法构造类型不正确的标记)。

{-# LANGUAGE GADTs #-}

(.<) :: IsScalar a => Token ((a, a) -> Bool)
(.<) = Operator (Lt scalarType)

(.+) :: IsNum a => Token ((a, a) -> a)
(.+) = Operator (Add numType)

(.==) :: IsScalar a => Token ((a, a) -> Bool)
(.==) = Operator (Eq scalarType)


lit7  :: Token Int
lit7  =  Operand 7

data Token a where
    Operand  :: (IsScalar a, Show a) => a -> Token a
    Operator :: Fun (a -> r) -> Token (a -> r)
    ParenL   :: Token ()
    ParenR   :: Token ()

-- The types of primitive functions
data Fun s where
    Lt   :: ScalarType a -> Fun ((a, a) -> Bool)
    Gt   :: ScalarType a -> Fun ((a, a) -> Bool)

    Eq   :: ScalarType a -> Fun ((a, a) -> Bool)
    NEq  :: ScalarType a -> Fun ((a, a) -> Bool)

    Add  :: NumType a -> Fun ((a, a) -> a)
    Mul  :: NumType a -> Fun ((a, a) -> a)

现在是类型类的所有提升内容:

-- Polymorphism. Use dictionaries in Haskell, in the DSL.

class IsScalar a where
  scalarType    :: ScalarType a

class (Num a, IsScalar a) => IsNum a where
  numType       :: NumType a

class (IsScalar a, IsNum a) => IsIntegral a where
  integralType  :: IntegralType a

instance IsIntegral Int where
  integralType = TypeInt IntegralDict

instance IsNum Int where
  numType = IntegralNumType integralType

instance IsScalar Int where
  scalarType = NumScalarType numType

data ScalarType a where
  NumScalarType    :: NumType a    -> ScalarType a
  NonNumScalarType :: NonNumType a -> ScalarType a

data NumType a where
  IntegralNumType :: IntegralType a -> NumType a

data IntegralType a where
  TypeInt     :: IntegralDict Int     -> IntegralType Int

data NonNumType a where
  TypeBool    :: NonNumDict Bool      -> NonNumType Bool

-- Reified dictionaries: lift our dictionaries to the DSL
data IntegralDict a where
  IntegralDict :: ( Bounded a, Enum a, Eq a, Ord a, Show a
                  , Integral a, Num a, Real a)
               => IntegralDict a

data NonNumDict a where
  NonNumDict :: (Eq a, Ord a, Show a)
             => NonNumDict a

这个想法来自新南威尔士大学 accelerate图书馆。