我的玩具语言的评估器不会进行类型检查

My toy language's evaluator won't type check

这是代码

{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}
{-# LANGUAGE GADTs, TypeFamilies                     #-}
{-# LANGUAGE ScopedTypeVariables, OverloadedStrings  #-}
module Lib where

import Control.Applicative
import Control.Monad.Except
import Control.Monad.State
import Data.Text

type Var = Text
type Store a = [(Var, Expr a)]
-- type EvalMonad a = ExceptT Text (State (Store a))

class (Num a, Eq a, Ord a) => Divisible a where
  divide :: a -> a -> a

instance Divisible Int where divide = div
instance Divisible Float where divide = (/)

data Expr a where
  BoolConst   ::  Bool -> Expr Bool
  NumberConst :: (Divisible n) => n -> Expr n
  SquanchyString :: Text -> Expr Text
  SquanchyVar :: Text -> Expr Text

  Not         :: Expr Bool -> Expr Bool
  Xor         :: Expr Bool -> Expr Bool -> Expr Bool

  Equals      :: (Eq a) => Expr a -> Expr a -> Expr Bool
  GreaterThan :: (Eq a) => Expr a -> Expr a -> Expr Bool

  Add         :: (Divisible n) => Expr n -> Expr n -> Expr n

eval :: Expr a -> ExceptT Text (State (Store a)) a
eval (BoolConst a)      = return a
eval (NumberConst a)    = return a 
eval (SquanchyString s) = return s

eval (SquanchyVar v) = extractValue v

eval (Not b)   = not <$> eval b
eval (Xor a b) = do
              orRes :: Bool <- (||) <$> eval a <*> eval b
              andRes :: Bool <- (&&) <$> eval a <*> eval b
              let notRes = not andRes
              return $ orRes && notRes

eval (Equals a b) = do -- This stanza is where the problem gets revealed
                      res :: Bool <- equals a b
                      return res
-- eval (GreaterThan a b) = (>) <$> eval a <*> eval b

eval (Add a b) = (+) <$> eval a <*> eval b
eval _             = undefined

equals :: (Eq n) => Expr n -> Expr n -> ExceptT Text (State (Store n)) Bool
equals a b = do
  eOne <- eval a
  eTwo <- eval b
  return $ eOne == eTwo

extractValue :: Text -> ExceptT Text (State (Store a)) a
extractValue v = do
    store :: Store a <- lift get
    case (lookup v store) of
      Just i -> eval i
      Nothing -> throwError "doh"

这是错误

• Could not deduce: a1 ~ Bool
  from the context: a ~ Bool
    bound by a pattern with constructor:
               Equals :: forall a. Expr a -> Expr a -> Expr Bool,
             in an equation for ‘eval’
    at /home/michael/git/brokensquanchy/src/Lib.hs:65:7-16
  ‘a1’ is a rigid type variable bound by
    a pattern with constructor:
      Equals :: forall a. Expr a -> Expr a -> Expr Bool,
    in an equation for ‘eval’
    at /home/michael/git/brokensquanchy/src/Lib.hs:65:7-16
  Expected type: ExceptT Text (State (Store a)) Bool
    Actual type: ExceptT Text (State (Store a1)) Bool
• In a stmt of a 'do' block: res :: Bool <- equals a b
  In the expression:
    do res :: Bool <- equals a b
       return res
  In an equation for ‘eval’:
      eval (Equals a b)
        = do res :: Bool <- equals a b
             return res
• Relevant bindings include
    b :: Expr a1
      (bound at /home/michael/git/brokensquanchy/src/Lib.hs:65:16)
    a :: Expr a1
      (bound at /home/michael/git/brokensquanchy/src/Lib.hs:65:14)
   |
66 |                       res :: Bool <- equals a b

我希望答案是包含缺失的类型信息,但我不太确定。有什么想法吗?

更新:我根据 chepner 的评论改进了我的代码。但是我仍然得到同样的错误。

为什么 ghc 认为 aa1 不同?不然我怎么说服它?

您的商店类型已损坏。特别是 eval 的 return 类型是:

ExceptT Text (State (Store a)) a

equals 的 return 类型是:

ExceptT Text (State (Store n)) Bool

只有当 an 都是 Bool 时,这些类型才能统一(对于 eval (Equals a b) = ... 的情况,它们必须统一),即,只有当你是比较两个布尔值的相等性,这显然不是你想要的。

更一般地说,您的商店类型 Store a 间接强制您的语言中的所有表达式具有相同的类型,即使在不使用任何变量的程序中也是如此(因为 a 是monad 类型的一部分,并且该类型需要在整个程序中保持相同),因此您不小心编写了一个可以 either 评估 Bool 表达式 or 计算 Text 表达式 or 计算数值表达式,但永远不能在单个程序中处理不同类型的表达式。

在您当前的语言中,您仅支持 Text 变量(通过 SquanchyVar),因此解决此问题的快速方法是更改​​每个出现的 Store a 或 [=26] =] 到 Store Text,并将 extractValue 修改为始终 return 一个 Text 值。因此,以下类型检查:

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE OverloadedStrings     #-}
module Lib where

import Control.Applicative
import Control.Monad.Except
import Control.Monad.State
import Data.Text

type Var = Text
type Store a = [(Var, Expr a)]
-- type EvalMonad a = ExceptT Text (State (Store a))

class (Num a, Eq a, Ord a) => Divisible a where
  divide :: a -> a -> a

instance Divisible Int where divide = div
instance Divisible Float where divide = (/)

data Expr a where
  BoolConst   ::  Bool -> Expr Bool
  NumberConst :: (Divisible n) => n -> Expr n
  SquanchyString :: Text -> Expr Text
  SquanchyVar :: Text -> Expr Text

  Not         :: Expr Bool -> Expr Bool
  And         :: Expr Bool -> Expr Bool -> Expr Bool
  Or          :: Expr Bool -> Expr Bool -> Expr Bool
  Xor         :: Expr Bool -> Expr Bool -> Expr Bool

  Equals      :: (Eq a) => Expr a -> Expr a -> Expr Bool

  GreaterThan :: (Eq a) => Expr a -> Expr a -> Expr Bool

  LessThan    :: (Eq a) => Expr a -> Expr a -> Expr Bool

  Div         :: (Divisible n) => Expr n -> Expr n -> Expr n

  Mul         :: (Divisible n) => Expr n -> Expr n -> Expr n

  Sub         :: (Divisible n) => Expr n -> Expr n -> Expr n

  Add         :: (Divisible n) => Expr n -> Expr n -> Expr n

eval :: Expr a -> ExceptT Text (State (Store Text)) a
eval (BoolConst a)      = return a
eval (NumberConst a)    = return a
eval (SquanchyString s) = return s

eval (SquanchyVar v) = extractValue v

eval (Not b)   = not <$> eval b
eval (And a b) = (&&) <$> eval a <*> eval b
eval (Or a b)  = (||) <$> eval a <*> eval b
eval (Xor a b) = do
              orRes :: Bool <- (||) <$> eval a <*> eval b
              andRes :: Bool <- (&&) <$> eval a <*> eval b
              let notRes = not andRes
              return $ orRes && notRes

eval (Equals a b) = do -- This stanza is where the problem gets revealed
                      res :: Bool <- equals a b
                      return res
-- eval (GreaterThan a b) = (>) <$> eval a <*> eval b
-- eval (LessThan a b)    = (<) <$> eval a <*> eval b

eval (Div a b) = divide <$> eval a <*> eval b
eval (Mul a b) = (*) <$> eval a <*> eval b
eval (Add a b) = (+) <$> eval a <*> eval b
eval (Sub a b) = (-) <$> eval a <*> eval b
eval _             = undefined

equals :: (Eq n) => Expr n -> Expr n -> ExceptT Text (State (Store Text)) Bool
equals a b = do
  eOne <- eval a
  eTwo <- eval b
  return $ eOne == eTwo

extractValue :: Text -> ExceptT Text (State (Store Text)) Text
extractValue v = do
    store :: Store a <- lift get
    case (lookup v store) of
      Just i -> eval i
      Nothing -> throwError "doh"

修复您的语言以支持具有多种类型的变量要复杂得多。

它们不一样a。 Equals 构造函数中的 aeval.

的泛型参数 a 不同

想象一下:

eval (Equals (SquanchyVar "foo") (SquanchyVar "bar"))

这里,Equals构造函数里面的aText(因为那是SquanchyVar的类型),但是a是泛型eval 的参数是 Bool (因为那是 Equals 的类型)。所以他们是不同的。

但更深层次的问题是你的 eval 只能 return 一种类型。因为它的结果类型 aeval 工作的 monad 类型 ExceptT Text (State (Store a)) 中也提到了,这意味着为了在同一个 monad 中,任何对 [=15= 的嵌套调用] 必须始终 return 与调用它们的外部 eval 相同的类型。

但是等等!你的 monad 实际上 需要 提及 a 吗?让我们看看它实际使用在哪里。看起来唯一使用的站点在 extractValue。看:它实际上并没有提取 any 类型的值,它只被期望与 Text.

一起使用

这就是解决方案:只需将 monad 设为 ExceptT Text (State (Store Text)) 而不是 ExceptT Text (State (Store a)).

eval :: Expr a -> ExceptT Text (State (Store Text)) a

...

equals :: (Eq n) => Expr n -> Expr n -> ExceptT Text (State (Store Text)) Bool

...

extractValue :: Text -> ExceptT Text (State (Store Text)) Text