我正在尝试编写一个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]
答案 0 :(得分:1)
当您有类型同义词
时type Foo = [Int]
Int
和[Int]
都是Show
的实例。所以当你说
instance Show Foo
为Show
创建[Int]
的新实例。所以现在你有了
x :: Foo
show x
可怜的编译器不知道要调用哪个版本的show
。所以它抱怨。这是一个重叠的实例&#34;因为这两个实例至少覆盖了一些相同的类型。
删除类型同义词的实例,但将其保留为data
类型。