struct variable type checking, refactoring to avoid circular dependencies
This commit is contained in:
parent
9f2fad1507
commit
1c1e25a881
15 changed files with 224 additions and 140 deletions
|
@ -1,8 +0,0 @@
|
|||
module Data.String.Ubc.Parse.FileScope
|
||||
( FileScope(..)
|
||||
)
|
||||
where
|
||||
|
||||
data FileScope = FileScope
|
||||
{
|
||||
}
|
|
@ -1,72 +0,0 @@
|
|||
module Data.String.Ubc.Parse.Struct
|
||||
( Struct(..)
|
||||
, parseStruct
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Arrow
|
||||
|
||||
import Text.Parsec
|
||||
|
||||
import Data.Map (Map)
|
||||
import Data.String.Ubc.Parse.StructVariable (StructVariable(StructVariable))
|
||||
import Data.String.Ubc.Parse.ParserState (ParserState)
|
||||
import Data.String.Ubc.Parse.StructScope (StructScope(..))
|
||||
import Data.String.Ubc.Parse.Scope (Scope(..))
|
||||
|
||||
import qualified Data.String.Ubc.Parse.Language as UbcLanguage
|
||||
import qualified Data.String.Ubc.Parse.StructScope as StructScope
|
||||
import qualified Data.String.Ubc.Parse.ParserState as ParserState
|
||||
import qualified Data.String.Ubc.Parse.Scope as Scope
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
||||
data Struct = Struct
|
||||
{ name :: String
|
||||
, memberVariables :: Map String StructVariable
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
parseStruct :: Monad m => ParsecT String ParserState m Struct
|
||||
parseStruct = do
|
||||
_ <- UbcLanguage.reserved "struct"
|
||||
|
||||
structIdentifier <- UbcLanguage.identifier
|
||||
let structScope = StructScope
|
||||
{ structName = structIdentifier
|
||||
, variables = Map.empty
|
||||
}
|
||||
|
||||
modifyState (ParserState.pushScope . ScopeStruct $ structScope)
|
||||
|
||||
_ <- UbcLanguage.braces (many structMember)
|
||||
|
||||
structScope <- getState >>= return . Scope.expectScopeStruct . snd . ParserState.popScope
|
||||
|
||||
return $ Struct (StructScope.structName structScope) (StructScope.variables structScope)
|
||||
|
||||
structMember :: Monad m => ParsecT String ParserState m ()
|
||||
structMember = choice [ structVariableOrFunction ]
|
||||
|
||||
structVariableOrFunction :: Monad m => ParsecT String ParserState m ()
|
||||
structVariableOrFunction = do
|
||||
(typeName, identifier) <- try $ do
|
||||
typeName <- UbcLanguage.identifier
|
||||
objectIdentifier <- UbcLanguage.identifier
|
||||
return $ (typeName, objectIdentifier)
|
||||
choice
|
||||
[ lookAhead (char ';') *> parseVariable typeName identifier
|
||||
] -- TODO: Functions on structs
|
||||
|
||||
parseVariable variableType variableName = do
|
||||
_ <- UbcLanguage.semicolon
|
||||
-- TODO: Validate type
|
||||
|
||||
(_, structScope) <- getState >>= return . (second Scope.expectScopeStruct) . ParserState.popScope
|
||||
if (== Nothing) . Map.lookup variableName . StructScope.variables $ structScope
|
||||
then do
|
||||
-- variable is not yet defined on the struct
|
||||
let structScope' = StructScope.modifyVariables (Map.insert variableName (StructVariable variableName variableType)) $ structScope
|
||||
modifyState (ParserState.pushScope $ ScopeStruct structScope')
|
||||
else do
|
||||
unexpected $ "name: \"" ++ variableName ++ "\", this name is already defined"
|
|
@ -1,11 +0,0 @@
|
|||
module Data.String.Ubc.Parse.StructVariable
|
||||
( StructVariable(..)
|
||||
)
|
||||
where
|
||||
|
||||
data StructVariable = StructVariable
|
||||
{ name :: String
|
||||
, typeName :: String
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
|
@ -1,5 +1,6 @@
|
|||
module Data.String.Ubc.Parse
|
||||
module Ubc.Parse
|
||||
( someFunc )
|
||||
where
|
||||
|
||||
someFunc :: IO ()
|
||||
someFunc = putStrLn "help"
|
14
src/Ubc/Parse/Data/Struct.hs
Normal file
14
src/Ubc/Parse/Data/Struct.hs
Normal file
|
@ -0,0 +1,14 @@
|
|||
module Ubc.Parse.Data.Struct
|
||||
( Struct(..)
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Map (Map)
|
||||
|
||||
import Ubc.Parse.VariableType (VariableType)
|
||||
|
||||
data Struct = Struct
|
||||
{ name :: String
|
||||
, memberVariables :: Map String VariableType
|
||||
}
|
||||
deriving (Show)
|
5
src/Ubc/Parse/File.hs
Normal file
5
src/Ubc/Parse/File.hs
Normal file
|
@ -0,0 +1,5 @@
|
|||
module Ubc.Parse.File
|
||||
(
|
||||
)
|
||||
where
|
||||
|
|
@ -1,39 +1,49 @@
|
|||
{-# LANGUAGE NoMonomorphismRestriction #-}
|
||||
module Data.String.Ubc.Parse.Language
|
||||
module Ubc.Parse.Language
|
||||
( languageDef
|
||||
, Data.String.Ubc.Parse.Language.identifier
|
||||
, Data.String.Ubc.Parse.Language.reserved
|
||||
, Data.String.Ubc.Parse.Language.operator
|
||||
, Data.String.Ubc.Parse.Language.reservedOperator
|
||||
, Data.String.Ubc.Parse.Language.characterLiteral
|
||||
, Data.String.Ubc.Parse.Language.stringLiteral
|
||||
, Data.String.Ubc.Parse.Language.natural
|
||||
, Data.String.Ubc.Parse.Language.integer
|
||||
, Data.String.Ubc.Parse.Language.float
|
||||
, Data.String.Ubc.Parse.Language.naturalOrFloat
|
||||
, Data.String.Ubc.Parse.Language.decimal
|
||||
, Data.String.Ubc.Parse.Language.hexadecimal
|
||||
, Data.String.Ubc.Parse.Language.octal
|
||||
, Data.String.Ubc.Parse.Language.symbol
|
||||
, Data.String.Ubc.Parse.Language.lexeme
|
||||
, Data.String.Ubc.Parse.Language.whiteSpace
|
||||
, Data.String.Ubc.Parse.Language.parens
|
||||
, Data.String.Ubc.Parse.Language.braces
|
||||
, Data.String.Ubc.Parse.Language.angles
|
||||
, Data.String.Ubc.Parse.Language.brackets
|
||||
, Data.String.Ubc.Parse.Language.semicolon
|
||||
, Data.String.Ubc.Parse.Language.comma
|
||||
, Data.String.Ubc.Parse.Language.colon
|
||||
, Data.String.Ubc.Parse.Language.dot
|
||||
, Data.String.Ubc.Parse.Language.semicolonSeparated
|
||||
, Data.String.Ubc.Parse.Language.semicolonSeparated1
|
||||
, Data.String.Ubc.Parse.Language.commaSeparated
|
||||
, Data.String.Ubc.Parse.Language.commaSeparated1
|
||||
, typeName
|
||||
, Ubc.Parse.Language.identifier
|
||||
, Ubc.Parse.Language.reserved
|
||||
, Ubc.Parse.Language.operator
|
||||
, Ubc.Parse.Language.reservedOperator
|
||||
, Ubc.Parse.Language.characterLiteral
|
||||
, Ubc.Parse.Language.stringLiteral
|
||||
, Ubc.Parse.Language.natural
|
||||
, Ubc.Parse.Language.integer
|
||||
, Ubc.Parse.Language.float
|
||||
, Ubc.Parse.Language.naturalOrFloat
|
||||
, Ubc.Parse.Language.decimal
|
||||
, Ubc.Parse.Language.hexadecimal
|
||||
, Ubc.Parse.Language.octal
|
||||
, Ubc.Parse.Language.symbol
|
||||
, Ubc.Parse.Language.lexeme
|
||||
, Ubc.Parse.Language.whiteSpace
|
||||
, Ubc.Parse.Language.parens
|
||||
, Ubc.Parse.Language.braces
|
||||
, Ubc.Parse.Language.angles
|
||||
, Ubc.Parse.Language.brackets
|
||||
, Ubc.Parse.Language.semicolon
|
||||
, Ubc.Parse.Language.comma
|
||||
, Ubc.Parse.Language.colon
|
||||
, Ubc.Parse.Language.dot
|
||||
, Ubc.Parse.Language.semicolonSeparated
|
||||
, Ubc.Parse.Language.semicolonSeparated1
|
||||
, Ubc.Parse.Language.commaSeparated
|
||||
, Ubc.Parse.Language.commaSeparated1
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Functor ( ($>) )
|
||||
import Text.Parsec
|
||||
( alphaNum, char, letter, oneOf, choice, (<|>), ParsecT )
|
||||
import Text.Parsec.Token
|
||||
( makeTokenParser,
|
||||
GenLanguageDef(..),
|
||||
GenTokenParser(TokenParser, identifier, reserved, operator,
|
||||
reservedOp, charLiteral, stringLiteral, natural, integer, float,
|
||||
naturalOrFloat, decimal, hexadecimal, octal, symbol, lexeme,
|
||||
whiteSpace, parens, braces, angles, brackets, semi, comma, colon,
|
||||
dot, semiSep, semiSep1, commaSep, commaSep1) )
|
||||
|
||||
languageDef :: Monad m => GenLanguageDef String u m
|
||||
languageDef = LanguageDef {
|
||||
|
@ -111,3 +121,11 @@ TokenParser{
|
|||
, commaSep = commaSeparated
|
||||
, commaSep1 = commaSeparated1
|
||||
} = tokenParser
|
||||
|
||||
typeName :: Monad m => ParsecT String u m String
|
||||
typeName = choice
|
||||
[ Ubc.Parse.Language.reserved "i32" $> "i32"
|
||||
, Ubc.Parse.Language.reserved "u32" $> "u32"
|
||||
, Ubc.Parse.Language.reserved "f32" $> "f32"
|
||||
, Ubc.Parse.Language.identifier
|
||||
]
|
|
@ -1,4 +1,4 @@
|
|||
module Data.String.Ubc.Parse.ParserState
|
||||
module Ubc.Parse.ParserState
|
||||
( ParserState(..)
|
||||
, initialState
|
||||
, pushScope
|
||||
|
@ -7,7 +7,7 @@ module Data.String.Ubc.Parse.ParserState
|
|||
)
|
||||
where
|
||||
|
||||
import Data.String.Ubc.Parse.Scope (Scope)
|
||||
import Ubc.Parse.Scope (Scope)
|
||||
|
||||
data ParserState = ParserState
|
||||
{ scopes :: [Scope]
|
||||
|
@ -17,10 +17,10 @@ initialState :: ParserState
|
|||
initialState = ParserState []
|
||||
|
||||
pushScope :: Scope -> ParserState -> ParserState
|
||||
pushScope scope oldState@ParserState{scopes = oldScopes} = oldState{scopes = (scope : oldScopes)}
|
||||
pushScope scope oldState@ParserState{scopes = oldScopes} = oldState{scopes = scope : oldScopes}
|
||||
|
||||
popScope :: ParserState -> (ParserState, Scope)
|
||||
popScope oldState@ParserState{scopes = (topScope:restScopes)} = (oldState{scopes = restScopes}, topScope)
|
||||
|
||||
modifyScope :: (Scope -> Scope) -> ParserState -> ParserState
|
||||
modifyScope f oldState@ParserState{scopes = (topScope:restScopes)} = oldState{scopes = (f topScope : restScopes)}
|
||||
modifyScope f oldState@ParserState{scopes = (topScope:restScopes)} = oldState{scopes = f topScope : restScopes}
|
|
@ -1,15 +1,16 @@
|
|||
module Data.String.Ubc.Parse.Scope
|
||||
module Ubc.Parse.Scope
|
||||
( Scope(..)
|
||||
, expectScopeStruct
|
||||
)
|
||||
where
|
||||
|
||||
import Data.String.Ubc.Parse.FileScope (FileScope)
|
||||
import Data.String.Ubc.Parse.StructScope (StructScope)
|
||||
import Ubc.Parse.Scope.FileScope (FileScope)
|
||||
import Ubc.Parse.Scope.StructScope (StructScope)
|
||||
|
||||
data Scope =
|
||||
ScopeFile FileScope
|
||||
| ScopeStruct StructScope
|
||||
|
||||
expectScopeStruct :: Scope -> StructScope
|
||||
expectScopeStruct (ScopeStruct s) = s
|
||||
expectScopeStruct _ = error "Internal Error: Top Scope is not Scope Struct"
|
11
src/Ubc/Parse/Scope/FileScope.hs
Normal file
11
src/Ubc/Parse/Scope/FileScope.hs
Normal file
|
@ -0,0 +1,11 @@
|
|||
module Ubc.Parse.Scope.FileScope
|
||||
( FileScope(..)
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Map (Map)
|
||||
import Ubc.Parse.Data.Struct (Struct)
|
||||
|
||||
data FileScope = FileScope
|
||||
{ structs :: Map String Struct
|
||||
}
|
|
@ -1,4 +1,4 @@
|
|||
module Data.String.Ubc.Parse.StructScope
|
||||
module Ubc.Parse.Scope.StructScope
|
||||
( StructScope(..)
|
||||
, modifyVariables
|
||||
)
|
||||
|
@ -6,14 +6,14 @@ where
|
|||
|
||||
import Data.Map (Map)
|
||||
|
||||
import Data.String.Ubc.Parse.StructVariable (StructVariable)
|
||||
import Ubc.Parse.VariableType (VariableType)
|
||||
|
||||
data StructScope = StructScope
|
||||
{ structName :: String
|
||||
, variables :: Map String StructVariable
|
||||
, variables :: Map String VariableType
|
||||
}
|
||||
|
||||
modifyVariables :: (Map String StructVariable -> Map String StructVariable) -> StructScope -> StructScope
|
||||
modifyVariables :: (Map String VariableType -> Map String VariableType) -> StructScope -> StructScope
|
||||
modifyVariables f scope@StructScope{variables = oldVariables} = scope{variables = newVariables}
|
||||
where
|
||||
newVariables = f oldVariables
|
89
src/Ubc/Parse/Struct.hs
Normal file
89
src/Ubc/Parse/Struct.hs
Normal file
|
@ -0,0 +1,89 @@
|
|||
module Ubc.Parse.Struct
|
||||
( Struct(..)
|
||||
, parseStruct
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Functor ( (<&>) )
|
||||
import Control.Arrow ( Arrow(second) )
|
||||
|
||||
import Text.Parsec
|
||||
( char,
|
||||
choice,
|
||||
getState,
|
||||
lookAhead,
|
||||
many,
|
||||
modifyState,
|
||||
try,
|
||||
unexpected,
|
||||
ParsecT )
|
||||
|
||||
import Ubc.Parse.ParserState (ParserState)
|
||||
import Ubc.Parse.Scope.StructScope (StructScope(..))
|
||||
import Ubc.Parse.Scope (Scope(..))
|
||||
import Ubc.Parse.Types (checkTypeValidity)
|
||||
import Ubc.Parse.Data.Struct (Struct(..))
|
||||
|
||||
import qualified Ubc.Parse.Language as UbcLanguage
|
||||
import qualified Ubc.Parse.Scope.StructScope as StructScope
|
||||
import qualified Ubc.Parse.ParserState as ParserState
|
||||
import qualified Ubc.Parse.Scope as Scope
|
||||
import qualified Ubc.Parse.VariableType as VariableType
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
||||
parseStruct :: Monad m => ParsecT String ParserState m Struct
|
||||
parseStruct = do
|
||||
_ <- UbcLanguage.reserved "struct"
|
||||
|
||||
structIdentifier <- UbcLanguage.identifier
|
||||
let structScope = StructScope
|
||||
{ structName = structIdentifier
|
||||
, variables = Map.empty
|
||||
}
|
||||
|
||||
modifyState (ParserState.pushScope . ScopeStruct $ structScope)
|
||||
|
||||
_ <- UbcLanguage.braces (many structMember)
|
||||
|
||||
structScope' <- getState <&> Scope.expectScopeStruct . snd . ParserState.popScope
|
||||
|
||||
return $ Struct (StructScope.structName structScope') (StructScope.variables structScope')
|
||||
|
||||
structMember :: Monad m => ParsecT String ParserState m ()
|
||||
structMember = choice [ structVariableOrFunction ]
|
||||
|
||||
structVariableOrFunction :: Monad m => ParsecT String ParserState m ()
|
||||
structVariableOrFunction = do
|
||||
(typeName, identifier) <- try $ do
|
||||
typeName <- UbcLanguage.typeName
|
||||
objectIdentifier <- UbcLanguage.identifier
|
||||
return (typeName, objectIdentifier)
|
||||
choice
|
||||
[ lookAhead (char ';') *> parseVariable typeName identifier
|
||||
] -- TODO: Functions on structs
|
||||
|
||||
parseVariable :: Monad m => String -> String -> ParsecT String ParserState m ()
|
||||
parseVariable variableType variableName = do
|
||||
_ <- UbcLanguage.semicolon
|
||||
-- TODO: Validate type
|
||||
|
||||
(_, structScope) <- getState <&> second Scope.expectScopeStruct . ParserState.popScope
|
||||
|
||||
-- check variable name
|
||||
if (/= Nothing) . Map.lookup variableName . StructScope.variables $ structScope
|
||||
then do
|
||||
unexpected $ "variable name: \"" ++ variableName ++ "\", this name is already defined"
|
||||
else do
|
||||
return ()
|
||||
|
||||
-- check type
|
||||
isKnownType <- checkTypeValidity variableType
|
||||
if not isKnownType
|
||||
then do
|
||||
unexpected $ "variable type: \"" ++ variableType ++ "\", this type is not defined"
|
||||
else do
|
||||
return ()
|
||||
|
||||
let structScope' = StructScope.modifyVariables (Map.insert variableName (VariableType.fromString variableType)) structScope
|
||||
modifyState (ParserState.pushScope $ ScopeStruct structScope')
|
20
src/Ubc/Parse/Types.hs
Normal file
20
src/Ubc/Parse/Types.hs
Normal file
|
@ -0,0 +1,20 @@
|
|||
module Ubc.Parse.Types
|
||||
( checkTypeValidity
|
||||
, getTypeNames
|
||||
)
|
||||
where
|
||||
|
||||
import Text.Parsec
|
||||
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import Ubc.Parse.ParserState (ParserState)
|
||||
|
||||
checkTypeValidity :: Monad m => String -> ParsecT String ParserState m Bool
|
||||
checkTypeValidity typeName = do
|
||||
typeNames <- getTypeNames >>= return . Set.union (Set.fromList ["i32", "u32", "f32"]) . Set.fromList
|
||||
return $ typeName `Set.member` typeNames
|
||||
|
||||
getTypeNames :: Monad m => ParsecT String ParserState m [String]
|
||||
getTypeNames = do
|
||||
return []
|
14
src/Ubc/Parse/VariableType.hs
Normal file
14
src/Ubc/Parse/VariableType.hs
Normal file
|
@ -0,0 +1,14 @@
|
|||
module Ubc.Parse.VariableType
|
||||
(VariableType(..)
|
||||
, fromString
|
||||
)
|
||||
where
|
||||
|
||||
data VariableType = BuiltInI32 | BuiltInU32 | BuiltInF32 | UserStruct String
|
||||
deriving (Show, Eq)
|
||||
|
||||
fromString :: String -> VariableType
|
||||
fromString "i32" = BuiltInI32
|
||||
fromString "u32" = BuiltInU32
|
||||
fromString "f32" = BuiltInF32
|
||||
fromString s = UserStruct s
|
18
ubcc.cabal
18
ubcc.cabal
|
@ -25,14 +25,16 @@ source-repository head
|
|||
|
||||
library
|
||||
exposed-modules:
|
||||
Data.String.Ubc.Parse
|
||||
Data.String.Ubc.Parse.FileScope
|
||||
Data.String.Ubc.Parse.Language
|
||||
Data.String.Ubc.Parse.ParserState
|
||||
Data.String.Ubc.Parse.Scope
|
||||
Data.String.Ubc.Parse.Struct
|
||||
Data.String.Ubc.Parse.StructScope
|
||||
Data.String.Ubc.Parse.StructVariable
|
||||
Ubc.Parse
|
||||
Ubc.Parse.Data.Struct
|
||||
Ubc.Parse.Language
|
||||
Ubc.Parse.ParserState
|
||||
Ubc.Parse.Scope
|
||||
Ubc.Parse.Scope.FileScope
|
||||
Ubc.Parse.Scope.StructScope
|
||||
Ubc.Parse.Struct
|
||||
Ubc.Parse.Types
|
||||
Ubc.Parse.VariableType
|
||||
other-modules:
|
||||
Paths_ubcc
|
||||
autogen-modules:
|
||||
|
|
Loading…
Reference in a new issue