Haskell Happy 解析器错误不匹配类型和无限类型

Haskell Happy parser error mismatching types and infinite type

编写一个类似 Oberon 的语言解析器,我在更新解析器以能够在同一级别定义更多过程后编译解析器时遇到了麻烦,而不仅仅是一个嵌套在另一个中。

这是我的词法分析器:

{
module Lexer where
}

%wrapper "basic"

$alpha      = [a-zA-Z]
$digit      = [0-9]
$validChar  = [^\"]

tokens :-

  $white+                             ;
  "PROCEDURE"                 { \s -> KW_TokenProcedure }
  "END"                       { \s -> KW_TokenEnd }
  ";"                         { \s -> KW_TokenSemiColon }
  $alpha [$alpha $digit \_]*  { \s -> TokenVariableIdentifier s }

{

-- The token type:
data Token =
  KW_TokenProcedure               |
  KW_TokenEnd                     |
  KW_TokenSemiColon               |
  TokenVariableIdentifier String  |
    deriving (Eq,Show)
}

这是我的解析器:

{
module Main where
import Lexer
import Tools
}

%name myParse
%tokentype { Token }
%error { parseError }

%token
  KW_PROCEDURE          { KW_TokenProcedure }
  KW_END                { KW_TokenEnd }
  ';'                   { KW_TokenSemiColon }
  identifier            { TokenVariableIdentifier $$ }

%%

ProcedureDeclarationList  :   ProcedureDeclaration                              {  }
                          |   ProcedureDeclaration ';' ProcedureDeclarationList {  :  }

ProcedureDeclaration  : ProcedureHeading ';' ProcedureBody identifier   {
                                                                          do
                                                                            let newProc =   -- Crea la nuova procedura
                                                                            let procBody = 
                                                                            addProcedureToProcedure newProc procBody
                                                                        }

ProcedureHeading        :   KW_PROCEDURE identifier { defaultProcedure { procedureName =  } }

ProcedureBody           : KW_END                                    { Nothing }
                        | DeclarationSequence KW_END                { Just  }

DeclarationSequence     :    ProcedureDeclarationList                 {  }

{
parseError :: [Token] -> a
parseError _ = error "Parse error"

main = do
  inStr <- getContents
  let result = oLikeParse (alexScanTokens inStr)
  putStrLn ("result: " ++ show(result))
}

这是定义类型和一些实用函数的模块:

module Tools where

data Procedure = Procedure {    procedureName :: String,
                                procedureProcedures :: [Procedure] } deriving (Show)

defaultProcedure = Procedure {  procedureName = "",
                                procedureProcedures = [] }

addProcedureToProcedure :: Procedure -> Maybe Procedure -> Procedure
addProcedureToProcedure procDest Nothing            = Procedure {   procedureName = (procedureName procDest),
                                                                    procedureProcedures = (procedureProcedures procDest) }
addProcedureToProcedure procDest (Just procToAdd)   = Procedure {   procedureName = (procedureName procDest),
                                                                    procedureProcedures = (procedureProcedures procDest) ++ [procToAdd] }

编译器给我的错误是这两个:

我已经确定了这个问题,我确信如果我删除我的 ProcedureDeclarationList 的第二个案例,一切都可以正常编译,但我无法识别同一级别的更多程序。


更新

我已经更改了我的数据结构,所以我不再使用 Maybe Procedure 并且我不需要两种类型的列表,但我仍然遇到类型不匹配的问题。

这是我更新的解析器:

{
module Main where
import Lexer
import Tools
}

%name myParse
%tokentype { Token }
%error { parseError }

%token
  KW_INTEGER            { KW_TokenInteger }
  KW_REAL               { KW_TokenReal }
  KW_BOOLEAN            { KW_TokenBoolean }
  KW_CHAR               { KW_TokenChar }
  KW_PROCEDURE          { KW_TokenProcedure }
  KW_END                { KW_TokenEnd }
  KW_VAR                { KW_TokenVar }
  ';'                   { KW_TokenSemiColon }
  ','                   { KW_TokenComa }
  ':'                   { KW_TokenColon }
  identifier            { TokenVariableIdentifier $$ }

%%

ProcedureDeclarationList  :   ProcedureDeclaration                              { [] }
                          |   ProcedureDeclaration ';' ProcedureDeclarationList { : }

ProcedureDeclaration  : ProcedureHeading ';' ProcedureBody identifier { defaultDeclaration { declarationType = DT_Procedure, procedureDeclared = (addBodyToProcedure  )} }

IdentifiersList     :   identifier                      { [] }
                    |   identifier ',' IdentifiersList  { : }

VariableDeclaration : IdentifiersList ':' type          { createVariablesDefinitionsOfType   }

ProcedureHeading    : KW_PROCEDURE identifier { defaultProcedure { procedureName =  } }

ProcedureBody     : KW_END                                      { [] }
                  | DeclarationSequence KW_END                  {  }

DeclarationSequence   : KW_VAR VariableDeclarationList ';'      {  }
                      | ProcedureDeclarationList                {  }

VariableDeclarationList : VariableDeclaration                             { [] }
                        | VariableDeclaration ';' VariableDeclarationList { : }

type        :   KW_INTEGER    { Integer }
            |   KW_REAL       { Float }
            |   KW_BOOLEAN    { Boolean }
            |   KW_CHAR       { Char }

{
parseError :: [Token] -> a
parseError _ = error "Parse error"

main = do
  inStr <- getContents
  let result = oLikeParse (alexScanTokens inStr)
  putStrLn ("result: " ++ show(result))
}

这是我更新的词法分析器:

{
module Lexer where
}

%wrapper "basic"

$alpha      = [a-zA-Z]
$digit      = [0-9]
$validChar  = [^\"]

tokens :-

  $white+                             ;
  "INTEGER"                   { \s -> KW_TokenInteger }
  "REAL"                      { \s -> KW_TokenReal }
  "BOOLEAN"                   { \s -> KW_TokenBoolean }
  "CHAR"                      { \s -> KW_TokenChar }
  "PROCEDURE"                 { \s -> KW_TokenProcedure }
  "END"                       { \s -> KW_TokenEnd }
  "VAR"                       { \s -> KW_TokenVar }
  ";"                         { \s -> KW_TokenSemiColon }
  ","                         { \s -> KW_TokenComa }
  ":"                         { \s -> KW_TokenColon }
  $alpha [$alpha $digit \_]*  { \s -> TokenVariableIdentifier s }

{

-- The token type:
data Token =
  KW_TokenInteger                 |
  KW_TokenReal                    |
  KW_TokenBoolean                 |
  KW_TokenChar                    |
  KW_TokenVar                     |
  KW_TokenProcedure               |
  KW_TokenEnd                     |
  KW_TokenSemiColon               |
  KW_TokenComa                    |
  KW_TokenColon                   |
  TokenVariableIdentifier String  |
    deriving (Eq,Show)
}

这是我更新的工具模块:

module Tools where

data AttributeType  = String
                    | Float
                    | Char
                    | Integer
                    | Boolean
                    deriving (Show, Eq)

data Attribute = Attribute {    attributeName :: String,
                                attributeType :: AttributeType,
                                stringValue :: String,
                                floatValue :: Float,
                                integerValue :: Integer,
                                charValue :: Char,
                                booleanValue :: Bool } deriving (Show)

data Procedure = Procedure {    procedureName :: String,
                                attributes :: [Attribute],
                                procedureProcedures :: [Procedure] } deriving (Show)

data DeclarationType    = DT_Variable
                        | DT_Constant
                        | DT_Procedure
                        deriving (Show, Eq)

data Declaration = Declaration {    declarationType     :: DeclarationType,
                                    attributeDeclared   :: Attribute,
                                    procedureDeclared   :: Procedure } deriving (Show)

defaultAttribute = Attribute {  attributeName = "",
                                attributeType = Integer,
                                stringValue = "",
                                floatValue = 0.0,
                                integerValue = 0,
                                charValue = ' ',
                                booleanValue = False }

defaultProcedure = Procedure {  procedureName = "",
                                attributes = [],
                                procedureProcedures = [] }

defaultDeclaration = Declaration {  declarationType = DT_Variable,
                                    attributeDeclared = defaultAttribute,
                                    procedureDeclared = defaultProcedure }

addAttributeToProcedure :: Procedure -> Attribute -> Procedure
addAttributeToProcedure proc att = Procedure {  procedureName = (procedureName proc),
                                                attributes = (attributes proc) ++ [att],
                                                procedureProcedures = (procedureProcedures proc) }

addProcedureToProcedure :: Procedure -> Procedure -> Procedure
addProcedureToProcedure procDest procToAdd  = Procedure {   procedureName = (procedureName procDest),
                                                            attributes = (attributes procDest),
                                                            procedureProcedures = (procedureProcedures procDest) ++ [procToAdd] }

addBodyToProcedure :: Procedure -> [Declaration] -> Procedure
addBodyToProcedure procDest []          =   procDest
addBodyToProcedure procDest declList    = do 
                                            let decl = head declList
                                            let declType = declarationType decl

                                            if declType == DT_Variable || declType == DT_Constant then 
                                                addBodyToProcedure (addAttributeToProcedure procDest (attributeDeclared decl)) (tail declList)
                                            else
                                                addBodyToProcedure (addProcedureToProcedure procDest (procedureDeclared decl)) (tail declList)

createVariablesDefinitionsOfType :: [String] -> AttributeType -> [Declaration]
createVariablesDefinitionsOfType namesList t = map (\x -> defaultDeclaration { declarationType = DT_Variable, attributeDeclared = (defaultAttribute {attributeName = x, attributeType = t})} ) namesList

这是生产类型的架构:

PRODUCTION                  TYPE
---------------             ---------------
ProcedureDeclarationList    [Declaration]
ProcedureDeclaration        Declaration
IdentifiersList             [String]
VariableDeclaration         [Declaration]
ProcedureHeading            Procedure
ProcedureBody               [Declaration]
DeclarationSequence         [Declaration]
VariableDeclarationList     [Declaration]
type                        AttributeType

这是我现在仅有的 3 个错误:

通过注释跟踪每个作品的类型将有助于您找出类型错误。

这里是每个作品应该有的类型:

Production                            Type
--------------                        ---------
ProcedureHeading                      Procedure
ProcedureDeclaration                  Procedure
ProcedureDeclarationList              [ Procedure ]
DeclarationSequence                   [ Procedure ]
ProcedureBody                         Maybe Procedure

现在检查您的每个生产规则,看看它们是否具有正确的类型。

  1. ProcedureHeading returns defaultProcedure 换个名字就可以了

  2. ProcedureDeclaration return 是调用 addProcedureToProcedure 的结果,因此可以结帐。请注意,addProcedureToProcedure 调用的第二个参数是 </code>,它指的是 <code>ProcedureBody 产生式的结果,因此这意味着该产生式的 return 类型必须是 Maybe Procedure.

  3. ProcedureDeclarationList 有问题。生产规则应为:

    ProcedureDeclarationList
      : ProcedureDeclaration                              { [  ] }
      | ProcedureDeclaration ';' ProcedureDeclarationList {  :  }
    

[] 从单个过程中创建一个列表,: 将单个过程添加到过程列表中。

  1. DeclarationSequence 只是一个 ProcedureDeclarationList,所以检查出来。

  2. 如第 2 步所述,ProcedureBody 必须是 Maybe ProcedureKW_END 的规则很好,但第二个规则需要一些工作:

    ProcedureBody
        | KW_END                     { Nothing }
        | DeclarationSequence KW_END { ??? }
    

DeclarationSequence(这是一个 [Procedure])我们必须产生一个 Maybe Procedure。这就是你的问题所在。 Just 的类型是 Maybe [Procedure],所以这在这里行不通。