Writing a Oberon-like language parser, I'm having troubles compiling the parser after I've updated it to be able to define more procedures on the same level, and not only nested one inside the other.
This is my lexer:
{
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)
}
This is my parser:
{
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 { $1 }
| ProcedureDeclaration ';' ProcedureDeclarationList { $3 : $1 }
ProcedureDeclaration : ProcedureHeading ';' ProcedureBody identifier {
do
let newProc = $1 -- Crea la nuova procedura
let procBody = $3
addProcedureToProcedure newProc procBody
}
ProcedureHeading : KW_PROCEDURE identifier { defaultProcedure { procedureName = $2 } }
ProcedureBody : KW_END { Nothing }
| DeclarationSequence KW_END { Just $1 }
DeclarationSequence : ProcedureDeclarationList { $1 }
{
parseError :: [Token] -> a
parseError _ = error "Parse error"
main = do
inStr <- getContents
let result = oLikeParse (alexScanTokens inStr)
putStrLn ("result: " ++ show(result))
}
And this is the module where the types and some utility functions are defined:
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] }
The errors the compiler is giving me are these two:
Couldn't match type ‘[Procedure]’ with ‘Procedure’Occurs check: cannot construct the infinite type: t4 ~ [t4]I've isolated the problem and I know for sure that if I remove the second case of my ProcedureDeclarationList everything compiles fine, but I can't recognize more procedures on the same level.
UPDATE
I've changed the my data structure so that I'm not using Maybe Procedure anymore and I won't need a list of two types, but I still have a problem with mismatching types.
This is my updated parser:
{
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 { [$1] }
| ProcedureDeclaration ';' ProcedureDeclarationList { $1:$3 }
ProcedureDeclaration : ProcedureHeading ';' ProcedureBody identifier { defaultDeclaration { declarationType = DT_Procedure, procedureDeclared = (addBodyToProcedure $1 $3)} }
IdentifiersList : identifier { [$1] }
| identifier ',' IdentifiersList { $1:$3 }
VariableDeclaration : IdentifiersList ':' type { createVariablesDefinitionsOfType $1 $3 }
ProcedureHeading : KW_PROCEDURE identifier { defaultProcedure { procedureName = $2 } }
ProcedureBody : KW_END { [] }
| DeclarationSequence KW_END { $1 }
DeclarationSequence : KW_VAR VariableDeclarationList ';' { $2 }
| ProcedureDeclarationList { $1 }
VariableDeclarationList : VariableDeclaration { [$1] }
| VariableDeclaration ';' VariableDeclarationList { $1:$3 }
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))
}
This is my updated lexer:
{
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)
}
And this is my updated tools module:
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
This is the schema of the production types:
PRODUCTION TYPE
--------------- ---------------
ProcedureDeclarationList [Declaration]
ProcedureDeclaration Declaration
IdentifiersList [String]
VariableDeclaration [Declaration]
ProcedureHeading Procedure
ProcedureBody [Declaration]
DeclarationSequence [Declaration]
VariableDeclarationList [Declaration]
type AttributeType
This are the only 3 errors I get now:
Couldn't match type ‘[Declaration]’ with ‘Declaration’ x2Couldn't match type ‘Declaration’ with ‘[Declaration]’Keeping track of the types of each production with comments will help you track down type errors.
Here the types each production should have:
Production Type
-------------- ---------
ProcedureHeading Procedure
ProcedureDeclaration Procedure
ProcedureDeclarationList [ Procedure ]
DeclarationSequence [ Procedure ]
ProcedureBody Maybe Procedure
Now check each of your production rules to see if they have the correct type.
ProcedureHeading returns defaultProcedure with a changed name, so that's ok.
ProcedureDeclaration returns the result of a call to addProcedureToProcedure, so that checks out. Note that the second argument to the addProcedureToProcedure call is $3 which refers to the result of a ProcedureBody production, so that means the return type of that production must be a Maybe Procedure.
ProcedureDeclarationList has problems. The production rules should read:
ProcedureDeclarationList
: ProcedureDeclaration { [ $1 ] }
| ProcedureDeclaration ';' ProcedureDeclarationList { $1 : $3 }
[$1] makes a list out of a single Procedure, and $1:$3 prepends a single Procedure to a list of Procedures.
DeclarationSequence is simply a ProcedureDeclarationList, so that checks out.
As noted in step 2, ProcedureBody has to be a Maybe Procedure. The rule for KW_END is fine, but the second rule needs some work:
ProcedureBody
| KW_END { Nothing }
| DeclarationSequence KW_END { ??? }
From a DeclarationSequence (which is a [Procedure]) we have to produce a Maybe Procedure. This is where your problem is. Just $1 has type Maybe [Procedure], so that isn't going to work here.