私は、While言語の拡張のために、x:=1
のような入力を受け取り、Ass "x" (N 1)
を返すProcと呼ばれる拡張機能のパーサーを作成しようとしています。'Show DecV'の無効なインスタンス宣言
{-# 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]
"DecV"は本格的なタイプではなく、単にタイプシノニム(キーワード 'タイプ'で示される)であることを意味します。あなたはvanilla Haskellの型同義語をインスタンス化することはできません。コンパイラからTypeSynonymInstances言語拡張を使用するように指示すると、タイプ同義語であるクラス型のインスタンスを作成できます。 – Antisthenes
あなたのコードでは、[(a、b)]はShowのインスタンスであるすべてのタイプaとbに対してshowのインスタンスであるため、DecVのShowのインスタンスを派生する必要はありません。このシノニムの "deriving"句を削除するだけで動作します。特定の型のコードをすべて1つの場所に保存し、コード内の不要な拡張子を削除できるようにするため、対応するデータ型定義に導出節を付けるようアドバイスします。 – Antisthenes
@Antisthenesは非常に感謝していますが、 'deriving'作品は削除されましたが、' pretty(Block decv decp stm) '行に 'Char'エラーがある' Var、Aexp '型の 'Could not match'型を持っています –