diff --git a/src/Data/String/Ubc/Parse/Error/StructError.hs b/src/Data/String/Ubc/Parse/Error/StructError.hs new file mode 100644 index 0000000..e077d7f --- /dev/null +++ b/src/Data/String/Ubc/Parse/Error/StructError.hs @@ -0,0 +1,11 @@ +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/FileScope.hs b/src/Data/String/Ubc/Parse/FileScope.hs new file mode 100644 index 0000000..1481063 --- /dev/null +++ b/src/Data/String/Ubc/Parse/FileScope.hs @@ -0,0 +1,8 @@ +module Data.String.Ubc.Parse.FileScope +( FileScope(..) +) +where + +data FileScope = FileScope + { + } diff --git a/src/Data/String/Ubc/Parse/Language.hs b/src/Data/String/Ubc/Parse/Language.hs index 739a509..4ceddaf 100644 --- a/src/Data/String/Ubc/Parse/Language.hs +++ b/src/Data/String/Ubc/Parse/Language.hs @@ -1,13 +1,41 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} module Data.String.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 ) where import Text.Parsec import Text.Parsec.Token -import Text.Parsec.Language -languageDef :: GenLanguageDef String u m +languageDef :: Monad m => GenLanguageDef String u m languageDef = LanguageDef { commentStart = "/*" , commentEnd = "*/" @@ -18,24 +46,68 @@ languageDef = LanguageDef { , opStart = oneOf "+-*/" , opLetter = oneOf "+-*/" , reservedNames = [ "struct", "u32", "i32", "f32" ] + , reservedOpNames = [ "+", "-", "*", "/" ] + , caseSensitive = True } -tokenParser :: GenTokenParser String u m +tokenParser :: Monad m => GenTokenParser String u m tokenParser = makeTokenParser languageDef +identifier :: Monad m => ParsecT String u m String +reserved :: Monad m => String -> ParsecT String u m () +operator :: Monad m => ParsecT String u m String +reservedOperator :: Monad m => String -> ParsecT String u m () +characterLiteral :: Monad m => ParsecT String u m Char +stringLiteral :: Monad m => ParsecT String u m String +natural :: Monad m => ParsecT String u m Integer +integer :: Monad m => ParsecT String u m Integer +float :: Monad m => ParsecT String u m Double +naturalOrFloat :: Monad m => ParsecT String u m (Either Integer Double) +decimal :: Monad m => ParsecT String u m Integer +hexadecimal :: Monad m => ParsecT String u m Integer +octal :: Monad m => ParsecT String u m Integer +symbol :: Monad m => String -> ParsecT String u m String +lexeme :: Monad m => ParsecT String u m a -> ParsecT String u m a +whiteSpace :: Monad m => ParsecT String u m () +parens :: Monad m => ParsecT String u m a -> ParsecT String u m a +braces :: Monad m => ParsecT String u m a -> ParsecT String u m a +angles :: Monad m => ParsecT String u m a -> ParsecT String u m a +brackets :: Monad m => ParsecT String u m a -> ParsecT String u m a +semicolon :: Monad m => ParsecT String u m String +comma :: Monad m => ParsecT String u m String +colon :: Monad m => ParsecT String u m String +dot :: Monad m => ParsecT String u m String +semicolonSeparated :: Monad m => ParsecT String u m a -> ParsecT String u m [a] +semicolonSeparated1 :: Monad m => ParsecT String u m a -> ParsecT String u m [a] +commaSeparated :: Monad m => ParsecT String u m a -> ParsecT String u m [a] +commaSeparated1 :: Monad m => ParsecT String u m a -> ParsecT String u m [a] TokenParser{ - identifier = identifier - , reserved = reserved - , operator = operator - , reservedOp = reservedOperator - , charLiteral = characterLiteral - , stringLiteral = stringLiteral - , natural = natural -- decimal, hexadecimal or octal - , integer = integer -- decimal, hexadecimal or octal - , float = float - , naturalOrFloat = naturalOrFloat - , decimal = decimal - , hexadecimal = hexadecimal - , octal = octal - , symbol = symbol + identifier = identifier + , reserved = reserved + , operator = operator + , reservedOp = reservedOperator + , charLiteral = characterLiteral + , stringLiteral = stringLiteral + , natural = natural -- decimal, hexadecimal or octal + , integer = integer -- decimal, hexadecimal or octal + , float = float + , naturalOrFloat = naturalOrFloat + , decimal = decimal + , hexadecimal = hexadecimal + , octal = octal + , symbol = symbol + , lexeme = lexeme + , whiteSpace = whiteSpace + , parens = parens + , braces = braces + , angles = angles + , brackets = brackets + , semi = semicolon + , comma = comma + , colon = colon + , dot = dot + , semiSep = semicolonSeparated + , semiSep1 = semicolonSeparated1 + , commaSep = commaSeparated + , commaSep1 = commaSeparated1 } = tokenParser diff --git a/src/Data/String/Ubc/Parse/ParserState.hs b/src/Data/String/Ubc/Parse/ParserState.hs new file mode 100644 index 0000000..ce37e4b --- /dev/null +++ b/src/Data/String/Ubc/Parse/ParserState.hs @@ -0,0 +1,18 @@ +module Data.String.Ubc.Parse.ParserState +( ParserState(..) +, initialState +, pushScope +) +where + +import Data.String.Ubc.Parse.Scope (Scope) + +data ParserState = ParserState + { scopes :: [Scope] + } + +initialState :: ParserState +initialState = ParserState [] + +pushScope :: Scope -> ParserState -> ParserState +pushScope scope oldState@ParserState{scopes = oldScopes} = oldState{scopes = (scope : oldScopes)} diff --git a/src/Data/String/Ubc/Parse/Scope.hs b/src/Data/String/Ubc/Parse/Scope.hs new file mode 100644 index 0000000..1dfc9d4 --- /dev/null +++ b/src/Data/String/Ubc/Parse/Scope.hs @@ -0,0 +1,11 @@ +module Data.String.Ubc.Parse.Scope +( Scope(..) +) +where + +import Data.String.Ubc.Parse.FileScope (FileScope) +import Data.String.Ubc.Parse.StructScope (StructScope) + +data Scope = + ScopeFile FileScope + | ScopeStruct StructScope diff --git a/src/Data/String/Ubc/Parse/Struct.hs b/src/Data/String/Ubc/Parse/Struct.hs new file mode 100644 index 0000000..d19e775 --- /dev/null +++ b/src/Data/String/Ubc/Parse/Struct.hs @@ -0,0 +1,49 @@ +module Data.String.Ubc.Parse.Struct +( Struct(..) +, parseStruct +) +where + +import Text.Parsec + +import Data.String.Ubc.Parse.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 + +data Struct = Struct + { name :: String + , memberVariables :: [StructVariable] + } + +parseStruct :: Monad m => ParsecT String ParserState m (Either StructError Struct) +parseStruct = do + _ <- UbcLanguage.reserved "struct" + + structName <- choice + [ UbcLanguage.identifier >>= return . Right + , getPosition >>= return . Left . StructError.MissingNameError + ] + let structScope = StructScope + { structName = either (const Nothing) (Just) structName + , errors = [] + } + + updateState (ParserState.pushScope . ScopeStruct $ structScope) + + openingBrace <- choice + [ UbcLanguage.symbol "{" >>= return . Right + , getPosition >>= return . Left . StructError.MissingBraceError . Left + ] + + closingBrace <- choice + [ UbcLanguage.symbol "}" >>= return . Right + , getPosition >>= return . Left . StructError.MissingBraceError . Right + ] + return $ Right $ Struct "" [] diff --git a/src/Data/String/Ubc/Parse/StructScope.hs b/src/Data/String/Ubc/Parse/StructScope.hs new file mode 100644 index 0000000..690aa8b --- /dev/null +++ b/src/Data/String/Ubc/Parse/StructScope.hs @@ -0,0 +1,11 @@ +module Data.String.Ubc.Parse.StructScope +( StructScope(..) +) +where + +import Data.String.Ubc.Parse.Error.StructError (StructError) + +data StructScope = StructScope + { structName :: Maybe String + , errors :: [StructError] + } diff --git a/src/Data/String/Ubc/Parse/StructVariable.hs b/src/Data/String/Ubc/Parse/StructVariable.hs new file mode 100644 index 0000000..4c8ec7e --- /dev/null +++ b/src/Data/String/Ubc/Parse/StructVariable.hs @@ -0,0 +1,9 @@ +module Data.String.Ubc.Parse.StructVariable +( StructVariable(..) +) +where + +data StructVariable = StructVariable + { name :: String + , typeName :: String + }