diff --git a/package.yaml b/package.yaml index ee38b0f..ca514a5 100644 --- a/package.yaml +++ b/package.yaml @@ -21,6 +21,7 @@ description: Please see the README on GitHub at = 4.7 && < 5 +- containers - parsec ghc-options: diff --git a/src/Data/String/Ubc/Parse/Error/StructError.hs b/src/Data/String/Ubc/Parse/Error/StructError.hs deleted file mode 100644 index e077d7f..0000000 --- a/src/Data/String/Ubc/Parse/Error/StructError.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Data.String.Ubc.Parse.Error.StructError -( StructError(..) -) -where - -import Text.Parsec (SourcePos) - -data StructError = - MissingNameError SourcePos - | MissingBraceError (Either SourcePos SourcePos) - -- the either branch indicates which one is missing diff --git a/src/Data/String/Ubc/Parse/ParserState.hs b/src/Data/String/Ubc/Parse/ParserState.hs index ce37e4b..57a7b2e 100644 --- a/src/Data/String/Ubc/Parse/ParserState.hs +++ b/src/Data/String/Ubc/Parse/ParserState.hs @@ -2,6 +2,8 @@ module Data.String.Ubc.Parse.ParserState ( ParserState(..) , initialState , pushScope +, popScope +, modifyScope ) where @@ -16,3 +18,9 @@ initialState = ParserState [] pushScope :: Scope -> ParserState -> ParserState 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)} diff --git a/src/Data/String/Ubc/Parse/Scope.hs b/src/Data/String/Ubc/Parse/Scope.hs index 1dfc9d4..4e9a2de 100644 --- a/src/Data/String/Ubc/Parse/Scope.hs +++ b/src/Data/String/Ubc/Parse/Scope.hs @@ -1,5 +1,6 @@ module Data.String.Ubc.Parse.Scope ( Scope(..) +, expectScopeStruct ) where @@ -9,3 +10,6 @@ import Data.String.Ubc.Parse.StructScope (StructScope) data Scope = ScopeFile FileScope | ScopeStruct StructScope + +expectScopeStruct (ScopeStruct s) = s +expectScopeStruct _ = error "Internal Error: Top Scope is not Scope Struct" diff --git a/src/Data/String/Ubc/Parse/Struct.hs b/src/Data/String/Ubc/Parse/Struct.hs index da4bb8e..406d954 100644 --- a/src/Data/String/Ubc/Parse/Struct.hs +++ b/src/Data/String/Ubc/Parse/Struct.hs @@ -4,54 +4,69 @@ module Data.String.Ubc.Parse.Struct ) where +import Control.Arrow + import Text.Parsec -import Data.String.Ubc.Parse.StructVariable (StructVariable) +import Data.Map (Map) +import Data.String.Ubc.Parse.StructVariable (StructVariable(StructVariable)) import Data.String.Ubc.Parse.ParserState (ParserState) -import Data.String.Ubc.Parse.Error.StructError (StructError) 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.Error.StructError as StructError 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 :: [StructVariable] + , memberVariables :: Map String StructVariable } + deriving (Show) -parseStruct :: Monad m => ParsecT String ParserState m (Either StructError Struct) +parseStruct :: Monad m => ParsecT String ParserState m Struct parseStruct = do _ <- UbcLanguage.reserved "struct" - structName <- choice - [ UbcLanguage.identifier >>= return . Right - , getPosition >>= return . Left . StructError.MissingNameError - ] + structIdentifier <- UbcLanguage.identifier let structScope = StructScope - { structName = either (const Nothing) (Just) structName - , errors = [] + { structName = structIdentifier + , variables = Map.empty } - updateState (ParserState.pushScope . ScopeStruct $ structScope) + modifyState (ParserState.pushScope . ScopeStruct $ structScope) - openingBrace <- choice - [ UbcLanguage.symbol "{" >>= return . Right - , getPosition >>= return . Left . StructError.MissingBraceError . Left - ] + _ <- UbcLanguage.braces (many structMember) - _ <- structMember `manyTill` (lookAhead $ choice [ eof, UbcLanguage.symbol "}" ]) + structScope <- getState >>= return . Scope.expectScopeStruct . snd . ParserState.popScope - closingBrace <- choice - [ UbcLanguage.symbol "}" >>= return . Right - , getPosition >>= return . Left . StructError.MissingBraceError . Right - ] - return $ Right $ Struct "" [] + 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/StructScope.hs b/src/Data/String/Ubc/Parse/StructScope.hs index 690aa8b..7dacc98 100644 --- a/src/Data/String/Ubc/Parse/StructScope.hs +++ b/src/Data/String/Ubc/Parse/StructScope.hs @@ -1,11 +1,19 @@ module Data.String.Ubc.Parse.StructScope ( StructScope(..) +, modifyVariables ) where -import Data.String.Ubc.Parse.Error.StructError (StructError) +import Data.Map (Map) + +import Data.String.Ubc.Parse.StructVariable (StructVariable) data StructScope = StructScope - { structName :: Maybe String - , errors :: [StructError] + { structName :: String + , variables :: Map String StructVariable } + +modifyVariables :: (Map String StructVariable -> Map String StructVariable) -> StructScope -> StructScope +modifyVariables f scope@StructScope{variables = oldVariables} = scope{variables = newVariables} + where + newVariables = f oldVariables diff --git a/src/Data/String/Ubc/Parse/StructVariable.hs b/src/Data/String/Ubc/Parse/StructVariable.hs index 4c8ec7e..b8221f5 100644 --- a/src/Data/String/Ubc/Parse/StructVariable.hs +++ b/src/Data/String/Ubc/Parse/StructVariable.hs @@ -7,3 +7,5 @@ data StructVariable = StructVariable { name :: String , typeName :: String } + deriving (Show, Eq) + diff --git a/stack.yaml b/stack.yaml index 7fabc3f..bf27fc6 100644 --- a/stack.yaml +++ b/stack.yaml @@ -17,8 +17,7 @@ # # snapshot: ./custom-snapshot.yaml # snapshot: https://example.com/snapshots/2024-01-01.yaml -snapshot: - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/2.yaml +snapshot: ghc-9.8.2 # User packages to be built. # Various formats can be used as shown in the example below. diff --git a/stack.yaml.lock b/stack.yaml.lock index 4eece14..b4a1752 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -1,13 +1,7 @@ # This file was autogenerated by Stack. # You should not edit this file by hand. # For more information, please see the documentation at: -# https://docs.haskellstack.org/en/stable/lock_files +# https://docs.haskellstack.org/en/stable/topics/lock_files packages: [] -snapshots: -- completed: - sha256: 90719ee9e630cf0535cc349cb35e007cec11db9462d598be78cf8ecbabd12c6c - size: 679061 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/2.yaml - original: - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/2.yaml +snapshots: [] diff --git a/ubcc.cabal b/ubcc.cabal index 98a5eda..2bfec5f 100644 --- a/ubcc.cabal +++ b/ubcc.cabal @@ -26,7 +26,6 @@ source-repository head library exposed-modules: Data.String.Ubc.Parse - Data.String.Ubc.Parse.Error.StructError Data.String.Ubc.Parse.FileScope Data.String.Ubc.Parse.Language Data.String.Ubc.Parse.ParserState @@ -43,6 +42,7 @@ library ghc-options: -Wall -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: base >=4.7 && <5 + , containers , parsec default-language: Haskell2010 @@ -57,6 +57,7 @@ executable ubcc-exe ghc-options: -Wall -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 + , containers , parsec , ubcc default-language: Haskell2010 @@ -73,6 +74,7 @@ test-suite ubcc-test ghc-options: -Wall -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 + , containers , parsec , ubcc default-language: Haskell2010