diff --git a/src/Data/String/Ubc/Parse/FileScope.hs b/src/Data/String/Ubc/Parse/FileScope.hs deleted file mode 100644 index 1481063..0000000 --- a/src/Data/String/Ubc/Parse/FileScope.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Data.String.Ubc.Parse.FileScope -( FileScope(..) -) -where - -data FileScope = FileScope - { - } diff --git a/src/Data/String/Ubc/Parse/Struct.hs b/src/Data/String/Ubc/Parse/Struct.hs deleted file mode 100644 index 406d954..0000000 --- a/src/Data/String/Ubc/Parse/Struct.hs +++ /dev/null @@ -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" diff --git a/src/Data/String/Ubc/Parse/StructVariable.hs b/src/Data/String/Ubc/Parse/StructVariable.hs deleted file mode 100644 index b8221f5..0000000 --- a/src/Data/String/Ubc/Parse/StructVariable.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Data.String.Ubc.Parse.StructVariable -( StructVariable(..) -) -where - -data StructVariable = StructVariable - { name :: String - , typeName :: String - } - deriving (Show, Eq) - diff --git a/src/Data/String/Ubc/Parse.hs b/src/Ubc/Parse.hs similarity index 57% rename from src/Data/String/Ubc/Parse.hs rename to src/Ubc/Parse.hs index 36604f8..8d2dd91 100644 --- a/src/Data/String/Ubc/Parse.hs +++ b/src/Ubc/Parse.hs @@ -1,5 +1,6 @@ -module Data.String.Ubc.Parse +module Ubc.Parse ( someFunc ) where +someFunc :: IO () someFunc = putStrLn "help" diff --git a/src/Ubc/Parse/Data/Struct.hs b/src/Ubc/Parse/Data/Struct.hs new file mode 100644 index 0000000..3568966 --- /dev/null +++ b/src/Ubc/Parse/Data/Struct.hs @@ -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) diff --git a/src/Ubc/Parse/File.hs b/src/Ubc/Parse/File.hs new file mode 100644 index 0000000..8faa380 --- /dev/null +++ b/src/Ubc/Parse/File.hs @@ -0,0 +1,5 @@ +module Ubc.Parse.File +( +) +where + diff --git a/src/Data/String/Ubc/Parse/Language.hs b/src/Ubc/Parse/Language.hs similarity index 67% rename from src/Data/String/Ubc/Parse/Language.hs rename to src/Ubc/Parse/Language.hs index 4ceddaf..faba1a9 100644 --- a/src/Data/String/Ubc/Parse/Language.hs +++ b/src/Ubc/Parse/Language.hs @@ -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 + ] diff --git a/src/Data/String/Ubc/Parse/ParserState.hs b/src/Ubc/Parse/ParserState.hs similarity index 78% rename from src/Data/String/Ubc/Parse/ParserState.hs rename to src/Ubc/Parse/ParserState.hs index 57a7b2e..0ba17c4 100644 --- a/src/Data/String/Ubc/Parse/ParserState.hs +++ b/src/Ubc/Parse/ParserState.hs @@ -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} diff --git a/src/Data/String/Ubc/Parse/Scope.hs b/src/Ubc/Parse/Scope.hs similarity index 61% rename from src/Data/String/Ubc/Parse/Scope.hs rename to src/Ubc/Parse/Scope.hs index 4e9a2de..8df05af 100644 --- a/src/Data/String/Ubc/Parse/Scope.hs +++ b/src/Ubc/Parse/Scope.hs @@ -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" diff --git a/src/Ubc/Parse/Scope/FileScope.hs b/src/Ubc/Parse/Scope/FileScope.hs new file mode 100644 index 0000000..2f2aeb8 --- /dev/null +++ b/src/Ubc/Parse/Scope/FileScope.hs @@ -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 + } diff --git a/src/Data/String/Ubc/Parse/StructScope.hs b/src/Ubc/Parse/Scope/StructScope.hs similarity index 53% rename from src/Data/String/Ubc/Parse/StructScope.hs rename to src/Ubc/Parse/Scope/StructScope.hs index 7dacc98..47b1ee5 100644 --- a/src/Data/String/Ubc/Parse/StructScope.hs +++ b/src/Ubc/Parse/Scope/StructScope.hs @@ -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 diff --git a/src/Ubc/Parse/Struct.hs b/src/Ubc/Parse/Struct.hs new file mode 100644 index 0000000..b5e16ed --- /dev/null +++ b/src/Ubc/Parse/Struct.hs @@ -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') diff --git a/src/Ubc/Parse/Types.hs b/src/Ubc/Parse/Types.hs new file mode 100644 index 0000000..008974d --- /dev/null +++ b/src/Ubc/Parse/Types.hs @@ -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 [] diff --git a/src/Ubc/Parse/VariableType.hs b/src/Ubc/Parse/VariableType.hs new file mode 100644 index 0000000..17b3025 --- /dev/null +++ b/src/Ubc/Parse/VariableType.hs @@ -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 diff --git a/ubcc.cabal b/ubcc.cabal index 2bfec5f..0b07d73 100644 --- a/ubcc.cabal +++ b/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: