我的玩具語言的評估器不會輸入檢查

這是代碼

{-# 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思考a和a1不同？我怎樣才能說服它？

uj5u.com熱心網友回復：

您的商店型別已損壞。具體來說，回傳型別eval為：

ExceptT Text (State (Store a)) a

而回傳型別equals為：

ExceptT Text (State (Store n)) Bool

這些型別只能在eval (Equals a b) = ...ifa和nare both的情況下統一（對于這種情況，它們必須如此） Bool，即只有當您比較兩個布林值的相等性時，這顯然不是您想要的。

更一般地說，您的商店的型別Store a間接地強制您語言中的所有運算式具有相同的型別，即使在不使用任何變數的程式中也是如此（因為它a是 monad 型別的一部分，并且該型別需要始終保持相同你的程式），所以你不小心撰寫了一個評估器，它可以評估運算式Bool或評估運算式Text或評估數字運算式，但永遠不能在單個程式中處理不同型別的運算式。

在您當前的語言中，您僅支持Text變數（通過SquanchyVar），因此解決此問題的快速方法是將每次出現的Store aor更改Store n為Store Text，并修改extractValue為始終回傳一個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"

修復您的語言以支持具有多種型別的變數要復雜得多。

uj5u.com熱心網友回復：

那些不一樣a。Equals 建構式的a內部不同于 的a泛型引數eval。

想象一下：

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

在這里，建構式a內部是（因為那是 的型別），但那是泛型引數是（因為那是 的型別）。所以他們是不同的。EqualsTextSquanchyVaraevalBoolEquals

但更深層次的問題是您eval只能回傳一種型別。因為它的結果型別在其下作業a的 monad 型別中也提到了，這意味著為了在同一個 monad 中，任何嵌套呼叫必須始終回傳與呼叫它們的外部相同的型別。ExceptT Text (State (Store a))evalevaleval

可是等等！您的 monad 真的需要提及a嗎？讓我們看看它實際使用在哪里。看起來唯一的使用站點是在extractValue. 看：它實際上并沒有提取任何型別的值，它只期望與Text.

所以這就是解決方案：只需制作你的 monadExceptT 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

標籤：

上一篇：計算每個元素的出現次數并將它們作為元組串列回傳

下一篇：divMod'用于更快計算的替代方案