'Show DecV'的非法实例声明

时间:2017-04-15 20:04:28

标签: haskell

我正在尝试编写一个Parser,用于扩展While语言,称为Proc,它接受x:=1等输入并返回Ass "x" (N 1)。到目前为止我的代码如下:

{-# LANGUAGE StandaloneDeriving #-}
module Attempt where
import Text.Megaparsec
import Text.Megaparsec.String
import Data.List (intercalate)
import Prelude hiding (Num)
import qualified Prelude (Num)
import System.IO
import Control.Monad

-- S ::= x:=a
--    | skip
--    | S1 ; S2
--    | if b then S1 else S2
--    | while b do S
--    | begin Dv Dv S end
--    | call p
-- Dv ::= var x := a ; DV | ε
-- Dp ::= proc p is S ; DP | ε

type Num   = Integer
type Var   = String
type Pname = String
type DecV  = [(Var,Aexp)]
type DecP  = [(Pname,Stm)]

--Parser

--A few preliminaries that import modules and language features before
--the full parser is defined.

cr :: Parser [Char]
cr = many (oneOf "\r\n")

tok :: String -> Parser String
tok t = string t <* whitespace

whitespace :: Parser ()
whitespace = many (oneOf " \t") *> pure ()

--Now each of the production rules in the grammar will be considered and
--translated into a corresponding datatype and parser.

-- a ::= | n | x | a1 + a2 | a1 * a2 | a1 - a2

data Aexp = N Num
          | V Var
          | Mult Aexp Aexp
          | Add Aexp Aexp
          | Sub Aexp Aexp

aexp :: Parser Aexp
aexp =  N     <$> num
    <|> V     <$> var
    <|> Mult  <$> aexp <* tok "*" <*> aexp
    <|> Add   <$> aexp <* tok "+" <*> aexp
    <|> Sub   <$> aexp <* tok "-" <*> aexp

-- b ::= true | false | a1 = a2 | a1 =< a2 | !b | b1 & b2

data Bexp = TRUE
          | FALSE
          | Neg Bexp
          | And Bexp Bexp
          | Le Aexp Aexp
          | Eq Aexp Aexp

bexp :: Parser Bexp
bexp = TRUE   <$ tok "TRUE"
   <|> FALSE  <$ tok "FALSE"
   <|> Neg    <$ tok "!" <*> bexp
   <|> And    <$> bexp <* tok "&" <*> bexp
   <|> Le     <$> aexp <* tok "=<" <*> aexp
   <|> Eq     <$> aexp <* tok "=" <*> aexp

-- S ::= x:=a
--    | skip
--    | S1 ; S2
--    | if b then S1 else S2
--    | while b do S
--    | begin Dv Dp S end
--    | call p

data Stm = Skip
          | Ass Var Aexp
          | Comp Stm Stm
          | If Bexp Stm Stm
          | While Bexp Stm
          | Block DecV DecP Stm
          | Call Pname

stm :: Parser Stm
stm = Skip    <$ tok "Skip"
  <|> Ass     <$ tok "Ass" <*> var <* tok ":=" <*> aexp
  <|> Comp    <$ tok "Comp" <*> stm <* tok ";" <*> stm
  <|> If      <$ tok "If" <*> bexp <* tok "then" <*> stm <* tok "else" <*> stm
  <|> While   <$ tok "While" <*> bexp <* tok "do" <*> stm
  <|> Block   <$ tok "Block" <* tok "begin" <*> decv <*> decp <*> stm <* tok "end"
  <|> Call    <$ tok "Call" <*> pname

-- Dv ::= var x := a ; DV | ε

decv :: Parser DecV
decv = many ((,) <$> var <* tok ":=" <*> aexp <* tok ";")

-- Dp ::= proc p is S ; DP | ε

decp :: Parser DecP
decp = many ((,) <$> pname <* tok "is" <*> stm <* tok ";")

num :: Parser Num
num = (some (oneOf ['0' .. '9']) >>= return . read) <* whitespace

var :: Parser Var
var = (some (oneOf ['A' .. 'Z'])) <* whitespace

pname :: Parser Pname
pname = tok "\"" *> some (noneOf ("\n\r\"")) <* tok "\""

whileParser :: Parser Stm
whileParser = whitespace >> stm

parseFile :: FilePath -> IO ()
parseFile filePath = do
  file <- readFile filePath
  putStrLn $ case parse whileParser filePath file of
    Left err          -> parseErrorPretty err
    Right whileParser -> pretty whileParser


--Pretty Printing
---------------

--The instances below allow values to be inspected in the terminal.
--The default instance that is derived shows all the constructor names.

deriving instance Show Aexp
deriving instance Show Bexp
deriving instance Show Stm
deriving instance Show DecV

--The pretty-printed output gives a version that should be acceptable
--Proc.

class Pretty a where
  pretty :: a -> String

instance Pretty Aexp where
  pretty (N num)            = show num
  pretty (V var)            = show var
  pretty (Mult aexp1 aexp2) = "Mult " ++ pretty aexp1 ++ " " ++ pretty aexp2
  pretty (Add aexp1 aexp2)  = "Add " ++ pretty aexp1 ++ " " ++ pretty aexp2
  pretty (Sub aexp1 aexp2)  = "Sub " ++ pretty aexp1 ++ " " ++ pretty aexp2

instance Pretty Bexp where
  pretty (TRUE)             = show True
  pretty (FALSE)            = show False
  pretty (Neg bexp)         = "!" ++ pretty bexp
  pretty (And bexp1 bexp2)  = pretty bexp1 ++ " & " ++ pretty bexp2
  pretty (Le aexp1 aexp2)   = pretty aexp1 ++ " =< " ++ pretty aexp2
  pretty (Eq aexp1 aexp2)   = pretty aexp1 ++ " = " ++ pretty aexp2

instance Pretty Stm where
  pretty (Skip)               = "Skip "
  pretty (Ass var aexp)       = "Ass " ++ var ++ " := " ++ pretty aexp
  pretty (Comp stm1 stm2)     = "Comp " ++ pretty stm1 ++ pretty stm2
  pretty (If bexp stm1 stm2)  = "If " ++ pretty bexp ++ " " ++ pretty stm1 ++ " " ++ pretty stm2
  pretty (While bexp stm)     = "While " ++ pretty bexp ++ " " ++ pretty stm
  pretty (Block decv decp stm)= "Block " ++ pretty decv ++ " " ++ pretty decp ++ " " ++ pretty stm
  pretty (Call pname)         = "Call " ++ pretty pname

wrap :: Char -> String
wrap c = [c]

但是当我尝试编译它时,我收到了来自deriving instance Show DecV行的以下错误:

Illegal instance declaration for ‘Show DecV’
  (All instance types must be of the form (T t1 ... tn)
   where T is not a synonym.
   Use TypeSynonymInstances if you want to disable this.)
In the stand-alone deriving instance for ‘Show DecV’

修改

从Stm,DecV和DecP的实例中移除deriving修复了该问题,并在Pretty Block中将pretty更改为show。我现在收到一个错误:

Overlapping instances for Show DecP arising from a use of ‘show’
Matching instances:
  instance Show a => Show [a] -- Defined in ‘GHC.Show’
  instance Show DecP -- Defined at 2ndattempt.hs:143:10
In the first argument of ‘(++)’, namely ‘show decp’
In the second argument of ‘(++)’, namely
  ‘show decp ++ " " ++ pretty stm’
In the second argument of ‘(++)’, namely
  ‘" " ++ show decp ++ " " ++ pretty stm’

目前的代码是:

{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module Attempt where
import Text.Megaparsec
import Text.Megaparsec.String
import Data.List (intercalate)
import Prelude hiding (Num)
import qualified Prelude (Num)
import System.IO
import Control.Monad

-- S ::= x:=a
--    | skip
--    | S1 ; S2
--    | if b then S1 else S2
--    | while b do S
--    | begin Dv Dv S end
--    | call p
-- Dv ::= var x := a ; DV | ε
-- Dp ::= proc p is S ; DP | ε

type Num   = Integer
type Var   = String
type Pname = String
type DecV  = [(Var,Aexp)]
type DecP  = [(Pname,Stm)]

--Parser

--A few preliminaries that import modules and language features before
--the full parser is defined.

cr :: Parser [Char]
cr = many (oneOf "\r\n")

tok :: String -> Parser String
tok t = string t <* whitespace

whitespace :: Parser ()
whitespace = many (oneOf " \t") *> pure ()

--Now each of the production rules in the grammar will be considered and
--translated into a corresponding datatype and parser.

-- a ::= | n | x | a1 + a2 | a1 * a2 | a1 - a2

data Aexp = N Num
          | V Var
          | Mult Aexp Aexp
          | Add Aexp Aexp
          | Sub Aexp Aexp

aexp :: Parser Aexp
aexp =  N     <$> num
    <|> V     <$> var
    <|> Mult  <$> aexp <* tok "*" <*> aexp
    <|> Add   <$> aexp <* tok "+" <*> aexp
    <|> Sub   <$> aexp <* tok "-" <*> aexp

-- b ::= true | false | a1 = a2 | a1 =< a2 | !b | b1 & b2

data Bexp = TRUE
          | FALSE
          | Neg Bexp
          | And Bexp Bexp
          | Le Aexp Aexp
          | Eq Aexp Aexp

bexp :: Parser Bexp
bexp = TRUE   <$ tok "TRUE"
   <|> FALSE  <$ tok "FALSE"
   <|> Neg    <$ tok "!" <*> bexp
   <|> And    <$> bexp <* tok "&" <*> bexp
   <|> Le     <$> aexp <* tok "=<" <*> aexp
   <|> Eq     <$> aexp <* tok "=" <*> aexp

-- S ::= x:=a
--    | skip
--    | S1 ; S2
--    | if b then S1 else S2
--    | while b do S
--    | begin Dv Dp S end
--    | call p

data Stm = Skip
          | Ass Var Aexp
          | Comp Stm Stm
          | If Bexp Stm Stm
          | While Bexp Stm
          | Block DecV DecP Stm
          | Call Pname

stm :: Parser Stm
stm = Skip    <$ tok "Skip"
  <|> Ass     <$ tok "Ass" <*> var <* tok ":=" <*> aexp
  <|> Comp    <$ tok "Comp" <*> stm <* tok ";" <*> stm
  <|> If      <$ tok "If" <*> bexp <* tok "then" <*> stm <* tok "else" <*> stm
  <|> While   <$ tok "While" <*> bexp <* tok "do" <*> stm
  <|> Block   <$ tok "Block" <* tok "begin" <*> decv <*> decp <*> stm <* tok "end"
  <|> Call    <$ tok "Call" <*> pname

-- Dv ::= var x := a ; DV | ε

decv :: Parser DecV
decv = many ((,) <$> var <* tok ":=" <*> aexp <* tok ";")

-- Dp ::= proc p is S ; DP | ε

decp :: Parser DecP
decp = many ((,) <$> pname <* tok "is" <*> stm <* tok ";")

num :: Parser Num
num = (some (oneOf ['0' .. '9']) >>= return . read) <* whitespace

var :: Parser Var
var = (some (oneOf ['A' .. 'Z'])) <* whitespace

pname :: Parser Pname
pname = tok "\"" *> some (noneOf ("\n\r\"")) <* tok "\""

whileParser :: Parser Stm
whileParser = whitespace >> stm

parseFile :: FilePath -> IO ()
parseFile filePath = do
  file <- readFile filePath
  putStrLn $ case parse whileParser filePath file of
    Left err          -> parseErrorPretty err
    Right whileParser -> pretty whileParser


--Pretty Printing
---------------

--The instances below allow values to be inspected in the terminal.
--The default instance that is derived shows all the constructor names.

deriving instance Show Aexp
deriving instance Show Bexp
instance Show Stm
instance Show DecV
instance Show DecP

--The pretty-printed output gives a version that should be acceptable
--Proc.

class Pretty a where
  pretty :: a -> String

instance Pretty Aexp where
  pretty (N num)            = show num
  pretty (V var)            = show var
  pretty (Mult aexp1 aexp2) = "Mult " ++ pretty aexp1 ++ " " ++ pretty aexp2
  pretty (Add aexp1 aexp2)  = "Add " ++ pretty aexp1 ++ " " ++ pretty aexp2
  pretty (Sub aexp1 aexp2)  = "Sub " ++ pretty aexp1 ++ " " ++ pretty aexp2

instance Pretty Bexp where
  pretty (TRUE)             = show True
  pretty (FALSE)            = show False
  pretty (Neg bexp)         = "!" ++ pretty bexp
  pretty (And bexp1 bexp2)  = pretty bexp1 ++ " & " ++ pretty bexp2
  pretty (Le aexp1 aexp2)   = pretty aexp1 ++ " =< " ++ pretty aexp2
  pretty (Eq aexp1 aexp2)   = pretty aexp1 ++ " = " ++ pretty aexp2

instance Pretty Stm where
  pretty (Skip)               = "Skip "
  pretty (Ass var aexp)       = "Ass " ++ var ++ " := " ++ pretty aexp
  pretty (Comp stm1 stm2)     = "Comp " ++ pretty stm1 ++ pretty stm2
  pretty (If bexp stm1 stm2)  = "If " ++ pretty bexp ++ " " ++ pretty stm1 ++ " " ++ pretty stm2
  pretty (While bexp stm)     = "While " ++ pretty bexp ++ " " ++ pretty stm
  pretty (Block decv decp stm)= "Block " ++ show decv ++ " " ++ show decp ++ " " ++ pretty stm
  pretty (Call pname)         = "Call " ++ pname

wrap :: Char -> String
wrap c = [c]

1 个答案:

答案 0 :(得分:1)

当您有类型同义词

type Foo = [Int]

Int[Int]都是Show的实例。所以当你说

instance Show Foo

Show创建[Int]的新实例。所以现在你有了

x :: Foo
show x

可怜的编译器不知道要调用哪个版本的show。所以它抱怨。这是一个重叠的实例&#34;因为这两个实例至少覆盖了一些相同的类型。

删除类型同义词的实例,但将其保留为data类型。