2017-04-15 25 views
1

私は、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] 
+1

"DecV"は本格的なタイプではなく、単にタイプシノニム(キーワード 'タイプ'で示される)であることを意味します。あなたはvanilla Haskellの型同義語をインスタンス化することはできません。コンパイラからTypeSynonymInstances言語拡張を使用するように指示すると、タイプ同義語であるクラス型のインスタンスを作成できます。 – Antisthenes

+1

あなたのコードでは、[(a、b)]はShowのインスタンスであるすべてのタイプaとbに対してshowのインスタンスであるため、DecVのShowのインスタンスを派生する必要はありません。このシノニムの "deriving"句を削除するだけで動作します。特定の型のコードをすべて1つの場所に保存し、コード内の不要な拡張子を削除できるようにするため、対応するデータ型定義に導出節を付けるようアドバイスします。 – Antisthenes

+0

@Antisthenesは非常に感謝していますが、 'deriving'作品は削除されましたが、' pretty(Block decv decp stm) '行に 'Char'エラーがある' Var、Aexp '型の 'Could not match'型を持っています –

答えて

0

あなたは

type Foo = [Int] 

Int[Int]はすでにShowの両方のインスタンスである型シノニムを持っている場合。あなたは

instance Show Foo 

を言うときですから、[Int]ためShowの新しいインスタンスを作成します。だから今は

x :: Foo 
show x 

を持っているとき貧しいコンパイラが呼び出すためにshowのどのバージョンを知っていません。だからそれは不平を言う。 2つのインスタンスが同じ型の少なくとも一部をカバーするため、これは「オーバーラップするインスタンス」です。

タイプ同義語のインスタンスは削除しますが、タイプはdataのままにしておきます。

関連する問題