diff --git a/app/Main.hs b/app/Main.hs index 528f28a..0bd8497 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,9 @@ module Main (main) where +import qualified Text.Parsec as Parsec +import qualified Ubc.Parse.Syntax.File as File main :: IO () main = do text <- getContents - return () + + print $ Parsec.parse File.parse "" text diff --git a/src/Ubc/Parse.hs b/src/Ubc/Parse.hs deleted file mode 100644 index d97b1a1..0000000 --- a/src/Ubc/Parse.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Ubc.Parse -( parseScript ) -where - -import Text.Parsec ( runPT, ParseError, SourceName, ParsecT ) - - -import qualified Ubc.Parse.Syntax.ParserState as ParserState -import qualified Ubc.Parse.Syntax.Config as Config - -parseScript :: Monad m => SourceName -> String -> m (Either ParseError ()) -parseScript = runPT topLevelParser (ParserState.initialState Config.defaultConfig) - -topLevelParser :: ParsecT s u m () -topLevelParser = return () diff --git a/src/Ubc/Parse/Syntax/Data/Struct.hs b/src/Ubc/Parse/Syntax/Data/Struct.hs index 49a2047..ece3e8d 100644 --- a/src/Ubc/Parse/Syntax/Data/Struct.hs +++ b/src/Ubc/Parse/Syntax/Data/Struct.hs @@ -1,14 +1,23 @@ module Ubc.Parse.Syntax.Data.Struct ( Struct(..) -) +, addVariable +, addFunction) where import Ubc.Parse.Syntax.VariableType (VariableType) +import Ubc.Parse.Syntax.Function (Function) type VariableName = String data Struct = Struct { name :: String - , memberVariables :: [(VariableName, VariableType)] + , variables :: [(VariableName, VariableType)] + , functions :: [Function] } deriving (Show) + +addVariable :: Struct -> VariableName -> VariableType -> Struct +addVariable (Struct sn vs fs) n t = Struct sn ((n, t): vs) fs + +addFunction :: Struct -> Function -> Struct +addFunction (Struct sn vs fs) f = Struct sn vs (f:fs) diff --git a/src/Ubc/Parse/Syntax/Expression.hs b/src/Ubc/Parse/Syntax/Expression.hs index 4467e35..55dc542 100644 --- a/src/Ubc/Parse/Syntax/Expression.hs +++ b/src/Ubc/Parse/Syntax/Expression.hs @@ -1,19 +1,20 @@ module Ubc.Parse.Syntax.Expression ( Expression(..) -, BinaryOperator(..) , expressionParser ) where import Control.Monad ( (<$!>) ) import Data.Functor ( (<&>), ($>) ) +import Data.Ratio ((%)) -import Text.Parsec.Expr (Operator(Infix), Assoc (AssocLeft, AssocRight), buildExpressionParser) -import Text.Parsec (ParsecT, (<|>), (), choice, option, many, many1, digit, lookAhead, oneOf, char, notFollowedBy) +import Text.Parsec.Expr (Operator(Infix, Prefix), Assoc (AssocLeft, AssocRight), buildExpressionParser) +import Text.Parsec (ParsecT, (<|>), (), choice, option, many1, digit, lookAhead, oneOf, char, notFollowedBy) + +import Ubc.Parse.Syntax.Statement (blockExpression, Statement) +import Ubc.Parse.Syntax.Operators (BinaryOperator(..), UnaryOperator (..)) import qualified Ubc.Parse.Syntax.Language as UbcLanguage -import Data.Ratio ((%)) -import Ubc.Parse.Syntax.Statement (Statement) data Expression = Binary BinaryOperator Expression Expression | Unary UnaryOperator Expression @@ -26,30 +27,6 @@ data Expression = Binary BinaryOperator Expression Expression | Block [Statement] deriving (Show) -data UnaryOperator = LogicNot - deriving (Show) - -data BinaryOperator = Plus - | Minus - | Multiply - | Divide - | Modulo - | ShiftLeft - | ShiftRight - | LessThan - | GreaterThan - | LessEqual - | GreaterEqual - | Equal - | NotEqual - | BitAnd - | BitOr - | BitXor - | LogicAnd - | LogicOr - | Assign - deriving (Show) - operatorTable :: Monad m => [[Operator String u m Expression]] operatorTable = [ @@ -61,6 +38,9 @@ operatorTable = [ Infix (UbcLanguage.reservedOperator "+" $> Binary Plus) AssocLeft , Infix (UbcLanguage.reservedOperator "-" $> Binary Minus) AssocLeft ] + , + [ Prefix (UbcLanguage.reservedOperator "!" $> Unary LogicNot) + ] , [ Infix (UbcLanguage.reservedOperator "<<" $> Binary ShiftLeft) AssocLeft , Infix (UbcLanguage.reservedOperator ">>" $> Binary ShiftRight) AssocLeft @@ -127,9 +107,6 @@ loopExpression startKeyword conditionWrapper = do condition <- conditionWrapper <$!> expressionParser Loop condition <$> expressionParser -blockExpression :: Monad m => ParsecT String u m Expression -blockExpression = UbcLanguage.braces (many expressionParser) <&> Block - conditionalExpression :: Monad m => String -> (Expression -> Expression) -> ParsecT String u m Expression conditionalExpression startKeyword conditionWrapper = do _ <- UbcLanguage.reserved startKeyword diff --git a/src/Ubc/Parse/Syntax/Expression.hs-boot b/src/Ubc/Parse/Syntax/Expression.hs-boot new file mode 100644 index 0000000..e18a003 --- /dev/null +++ b/src/Ubc/Parse/Syntax/Expression.hs-boot @@ -0,0 +1,18 @@ +module Ubc.Parse.Syntax.Expression +where + +import Text.Parsec (ParsecT) +import Ubc.Parse.Syntax.Operators (BinaryOperator, UnaryOperator) +import {-# SOURCE #-} Ubc.Parse.Syntax.Statement (Statement) + +data Expression = Binary BinaryOperator Expression Expression + | Unary UnaryOperator Expression + | ConstantInteger Integer + | ConstantFraction Rational + | FunctionCall String [Expression] + | Variable String + | If Expression Expression (Maybe Expression) -- if then else + | Loop Expression Expression -- condition body + | Block [Statement] +instance Show Expression +expressionParser :: Monad m => ParsecT String u m Expression diff --git a/src/Ubc/Parse/Syntax/File.hs b/src/Ubc/Parse/Syntax/File.hs index 7569950..1548c52 100644 --- a/src/Ubc/Parse/Syntax/File.hs +++ b/src/Ubc/Parse/Syntax/File.hs @@ -1,5 +1,45 @@ module Ubc.Parse.Syntax.File -( +( File(..) +, parse ) where +import Control.Monad ((<$!>)) + +import Text.Parsec (choice, ParsecT, many) + +import Ubc.Parse.Syntax.Data.Struct ( Struct ) +import Ubc.Parse.Syntax.Function (Function) +import Ubc.Parse.Syntax.Statement (Statement) +import qualified Ubc.Parse.Syntax.Struct as Struct +import qualified Ubc.Parse.Syntax.Function as Function +import qualified Ubc.Parse.Syntax.Statement as Statement + +data File = File + { name :: String + , structs :: [Struct] + , functions :: [Function] + , statements :: [Statement] + } + deriving (Show) + +data FileMember = FileFunction Function + | FileStruct Struct + | FileStatement Statement + +accumulateFile :: File -> FileMember -> File +accumulateFile (File name_ struct_ functions_ statements_) (FileFunction f) = File name_ struct_ (f:functions_) statements_ +accumulateFile (File name_ struct_ functions_ statements_) (FileStatement s) = File name_ struct_ functions_ (s:statements_) +accumulateFile (File name_ struct_ functions_ statements_) (FileStruct s) = File name_ (s:struct_) functions_ statements_ + +parse :: Monad m => ParsecT String u m File +parse = foldl accumulateFile (File "" [] [] []) <$!> many fileMember + +fileMember :: Monad m => ParsecT String u m FileMember +fileMember = choice + [ FileStruct <$!> Struct.parse + , FileFunction <$!> Function.parse + , FileStatement <$!> Statement.parse + ] + + diff --git a/src/Ubc/Parse/Syntax/Function.hs b/src/Ubc/Parse/Syntax/Function.hs index 2621170..ab8053a 100644 --- a/src/Ubc/Parse/Syntax/Function.hs +++ b/src/Ubc/Parse/Syntax/Function.hs @@ -1,6 +1,7 @@ module Ubc.Parse.Syntax.Function ( Function(..) -, parseFunction +, parse +, parsePrefixed ) where @@ -9,7 +10,7 @@ import Control.Monad ((<$!>)) import Text.Parsec (lookAhead, try, ParsecT) import Ubc.Parse.Syntax.VariableType (VariableType) -import Ubc.Parse.Syntax.Expression (Expression, expressionParser) +import {-# SOURCE #-} Ubc.Parse.Syntax.Expression (Expression, expressionParser) import qualified Ubc.Parse.Syntax.Language as UbcLanguage import qualified Ubc.Parse.Syntax.VariableType as VariableType @@ -22,19 +23,23 @@ data Function = Function } deriving (Show) -parseFunction :: Monad m => ParsecT String u m Function -parseFunction = do +parsePrefixed :: Monad m => VariableType -> String -> ParsecT String u m Function +parsePrefixed ftype fname = do + argumentList <- UbcLanguage.parens (UbcLanguage.commaSeparated argumentDefinition) + + expressionBody <- expressionParser + + return $ Function fname ftype expressionBody argumentList + +parse :: Monad m => ParsecT String u m Function +parse = do (resultType, name) <- try $ do resultType <- UbcLanguage.typeName name <- UbcLanguage.identifier _ <- lookAhead $ UbcLanguage.symbol "(" return (VariableType.fromString resultType, name) - argumentList <- UbcLanguage.parens (UbcLanguage.commaSeparated argumentDefinition) - - expressionBody <- expressionParser - - return $ Function name resultType expressionBody argumentList + parsePrefixed resultType name argumentDefinition :: Monad m => ParsecT String u m (VariableType, String) argumentDefinition = do diff --git a/src/Ubc/Parse/Syntax/Operators.hs b/src/Ubc/Parse/Syntax/Operators.hs new file mode 100644 index 0000000..435a57b --- /dev/null +++ b/src/Ubc/Parse/Syntax/Operators.hs @@ -0,0 +1,29 @@ +module Ubc.Parse.Syntax.Operators +( UnaryOperator(..) +, BinaryOperator(..) +) +where + +data UnaryOperator = LogicNot + deriving (Show) + +data BinaryOperator = Plus + | Minus + | Multiply + | Divide + | Modulo + | ShiftLeft + | ShiftRight + | LessThan + | GreaterThan + | LessEqual + | GreaterEqual + | Equal + | NotEqual + | BitAnd + | BitOr + | BitXor + | LogicAnd + | LogicOr + | Assign + deriving (Show) diff --git a/src/Ubc/Parse/Syntax/ParserState.hs b/src/Ubc/Parse/Syntax/ParserState.hs deleted file mode 100644 index f91f983..0000000 --- a/src/Ubc/Parse/Syntax/ParserState.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Ubc.Parse.Syntax.ParserState -( ParserState(..) -, initialState -, pushScope -, popScope -, modifyScope -) -where - -import Ubc.Parse.Syntax.Scope (Scope) -import Ubc.Parse.Syntax.Config (Config) - -data ParserState = ParserState - { scopes :: [Scope] - , config :: Config - } - -initialState :: Config -> ParserState -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/Ubc/Parse/Syntax/Scope.hs b/src/Ubc/Parse/Syntax/Scope.hs deleted file mode 100644 index 8c8d2d8..0000000 --- a/src/Ubc/Parse/Syntax/Scope.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Ubc.Parse.Syntax.Scope -( Scope(..) -, expectScopeStruct -) -where - -import Ubc.Parse.Syntax.Scope.FileScope (FileScope) -import Ubc.Parse.Syntax.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/Syntax/Scope/FileScope.hs b/src/Ubc/Parse/Syntax/Scope/FileScope.hs deleted file mode 100644 index 02bbe46..0000000 --- a/src/Ubc/Parse/Syntax/Scope/FileScope.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Ubc.Parse.Syntax.Scope.FileScope -( FileScope(..) -) -where - -import Data.Map (Map) -import Ubc.Parse.Syntax.Data.Struct (Struct) - -data FileScope = FileScope - { structs :: Map String Struct - } diff --git a/src/Ubc/Parse/Syntax/Scope/StructScope.hs b/src/Ubc/Parse/Syntax/Scope/StructScope.hs deleted file mode 100644 index 7859150..0000000 --- a/src/Ubc/Parse/Syntax/Scope/StructScope.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Ubc.Parse.Syntax.Scope.StructScope -( StructScope(..) -, modifyVariables -) -where - -import Ubc.Parse.Syntax.VariableType (VariableType) - -type VariableName = String - -data StructScope = StructScope - { structName :: String - , variables :: [(VariableName, VariableType)] - } - -modifyVariables :: ([(VariableName, VariableType)] -> [(VariableName, VariableType)]) -> StructScope -> StructScope -modifyVariables f scope@StructScope{variables = oldVariables} = scope{variables = newVariables} - where - newVariables = f oldVariables diff --git a/src/Ubc/Parse/Syntax/Statement.hs b/src/Ubc/Parse/Syntax/Statement.hs index 6dad130..20a3231 100644 --- a/src/Ubc/Parse/Syntax/Statement.hs +++ b/src/Ubc/Parse/Syntax/Statement.hs @@ -1,32 +1,35 @@ module Ubc.Parse.Syntax.Statement ( Statement(..) -, parseStatement) +, parse +, blockExpression +) where import Ubc.Parse.Syntax.VariableType (VariableType) -import Ubc.Parse.Syntax.Expression (Expression, expressionParser) +import {-# SOURCE #-} Ubc.Parse.Syntax.Expression (expressionParser, Expression (Block)) import Ubc.Parse.Syntax.TypeExpression (TypeExpression) -import Text.Parsec (choice, ParsecT, try) +import Text.Parsec (choice, ParsecT, try, many) import qualified Ubc.Parse.Syntax.Language as UbcLanguage import qualified Ubc.Parse.Syntax.VariableType as VariableType import qualified Ubc.Parse.Syntax.TypeExpression as TypeExpression -import Ubc.Parse.Syntax.ParserState (ParserState) import Control.Monad ((<$!>)) +import Data.Functor ((<&>)) type VariableName = String type TypeName = String - data Statement = VariableDefinition VariableType VariableName Expression | TypeDefinition TypeName TypeExpression | ExpressionStatement Expression + deriving (Show) -parseStatement :: Monad m => ParsecT String ParserState m Statement -parseStatement = choice [ variableDefinition + +parse :: Monad m => ParsecT String u m Statement +parse = choice [ variableDefinition , typeDefinition , ExpressionStatement <$!> expressionParser ] -typeDefinition :: Monad m => ParsecT String ParserState m Statement +typeDefinition :: Monad m => ParsecT String u m Statement typeDefinition = do UbcLanguage.reserved "type" @@ -47,3 +50,5 @@ variableDefinition = do VariableDefinition variableType variableName <$> expressionParser +blockExpression :: Monad m => ParsecT String u m Expression +blockExpression = UbcLanguage.braces (many parse) <&> Block diff --git a/src/Ubc/Parse/Syntax/Statement.hs-boot b/src/Ubc/Parse/Syntax/Statement.hs-boot new file mode 100644 index 0000000..5918975 --- /dev/null +++ b/src/Ubc/Parse/Syntax/Statement.hs-boot @@ -0,0 +1,4 @@ +module Ubc.Parse.Syntax.Statement +where + +data Statement diff --git a/src/Ubc/Parse/Syntax/Struct.hs b/src/Ubc/Parse/Syntax/Struct.hs index c536211..77d02df 100644 --- a/src/Ubc/Parse/Syntax/Struct.hs +++ b/src/Ubc/Parse/Syntax/Struct.hs @@ -1,71 +1,56 @@ module Ubc.Parse.Syntax.Struct ( Struct(..) -, parseStruct +, parse ) where -import Data.Functor ( (<&>) ) -import Control.Arrow ( (>>>) ) +import Control.Monad ((<$!>)) import Text.Parsec - ( char, - choice, - getState, - lookAhead, + ( choice, many, - modifyState, try, - ParsecT ) + ParsecT, + ) -import Ubc.Parse.Syntax.ParserState (ParserState) -import Ubc.Parse.Syntax.Scope.StructScope (StructScope(..)) -import Ubc.Parse.Syntax.Scope (Scope(..)) import Ubc.Parse.Syntax.Data.Struct (Struct(..)) +import Ubc.Parse.Syntax.VariableType (VariableType) import qualified Ubc.Parse.Syntax.Language as UbcLanguage -import qualified Ubc.Parse.Syntax.Scope.StructScope as StructScope -import qualified Ubc.Parse.Syntax.ParserState as ParserState -import qualified Ubc.Parse.Syntax.Scope as Scope import qualified Ubc.Parse.Syntax.VariableType as VariableType +import qualified Ubc.Parse.Syntax.Data.Struct as Struct +import qualified Ubc.Parse.Syntax.Function as Function +type VariableName = String +data StructStatement = Variable VariableName VariableType + | Function Function.Function -parseStruct :: Monad m => ParsecT String ParserState m Struct -parseStruct = do +parse :: Monad m => ParsecT String u m Struct +parse = do _ <- UbcLanguage.reserved "struct" - structIdentifier <- UbcLanguage.identifier - let structScope = StructScope - { structName = structIdentifier - , variables = [] - } - modifyState (ParserState.pushScope . ScopeStruct $ structScope) + foldl accumulateStruct (Struct structIdentifier [] []) <$!> UbcLanguage.braces (many structMember) - _ <- UbcLanguage.braces (many structMember) +accumulateStruct :: Struct -> StructStatement -> Struct +accumulateStruct s (Variable n t) = Struct.addVariable s n t +accumulateStruct s (Function f) = Struct.addFunction s f - structScope' <- getState <&> Scope.expectScopeStruct . snd . ParserState.popScope - - return $ Struct (StructScope.structName structScope') (StructScope.variables structScope') - -structMember :: Monad m => ParsecT String ParserState m () +structMember :: Monad m => ParsecT String u m StructStatement structMember = choice [ structVariableOrFunction ] -structVariableOrFunction :: Monad m => ParsecT String ParserState m () +structVariableOrFunction :: Monad m => ParsecT String u m StructStatement structVariableOrFunction = do (typeName, identifier) <- try $ do typeName <- UbcLanguage.typeName objectIdentifier <- UbcLanguage.identifier - return (typeName, objectIdentifier) - choice - [ lookAhead (char ';') *> parseVariable typeName identifier + return (VariableType.fromString typeName, objectIdentifier) + choice + [ parseVariable typeName identifier + , Function <$!> Function.parsePrefixed typeName identifier ] -- TODO: Functions on structs -parseVariable :: Monad m => String -> String -> ParsecT String ParserState m () +parseVariable :: Monad m => VariableType -> String -> ParsecT String u m StructStatement parseVariable variableType variableName = do _ <- UbcLanguage.semicolon - - modifyState (ParserState.modifyScope (Scope.expectScopeStruct - >>> StructScope.modifyVariables ((variableName, VariableType.fromString variableType):) - >>> Scope.ScopeStruct - ) - ) + return $ Variable variableName variableType diff --git a/src/Ubc/Parse/Syntax/TypeExpression.hs b/src/Ubc/Parse/Syntax/TypeExpression.hs index 2043179..6430128 100644 --- a/src/Ubc/Parse/Syntax/TypeExpression.hs +++ b/src/Ubc/Parse/Syntax/TypeExpression.hs @@ -3,20 +3,25 @@ module Ubc.Parse.Syntax.TypeExpression , parseTypeExpression ) where + +import Control.Monad ((<$!>)) + +import Text.Parsec (choice, ParsecT) + import Ubc.Parse.Syntax.VariableType (VariableType) import Ubc.Parse.Syntax.Data.Struct (Struct) -import Text.Parsec (choice, ParsecT) + import qualified Ubc.Parse.Syntax.Language as UbcLanguage import qualified Ubc.Parse.Syntax.VariableType as VariableType -import Control.Monad ((<$!>)) import qualified Ubc.Parse.Syntax.Struct as Struct -import Ubc.Parse.Syntax.ParserState (ParserState) data TypeExpression = TypeAlias VariableType | StructExpression Struct + deriving (Show) -parseTypeExpression :: Monad m => ParsecT String ParserState m TypeExpression + +parseTypeExpression :: Monad m => ParsecT String u m TypeExpression parseTypeExpression = choice [ TypeAlias . VariableType.fromString <$!> UbcLanguage.typeName - , StructExpression <$!> Struct.parseStruct + , StructExpression <$!> Struct.parse ] diff --git a/src/Ubc/Parse/Syntax/Types.hs b/src/Ubc/Parse/Syntax/Types.hs deleted file mode 100644 index a345f4b..0000000 --- a/src/Ubc/Parse/Syntax/Types.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Ubc.Parse.Syntax.Types -( checkTypeValidity -, getTypeNames -) -where - -import qualified Data.Set as Set - -import Text.Parsec ( ParsecT ) - -import Ubc.Parse.Syntax.ParserState (ParserState) -import Control.Monad ((<$!>)) - -checkTypeValidity :: Monad m => String -> ParsecT String ParserState m Bool -checkTypeValidity typeName = do - typeNames <- Set.union (Set.fromList ["i32", "u32", "f32"]) . Set.fromList <$!> getTypeNames - return $ typeName `Set.member` typeNames - -getTypeNames :: Monad m => ParsecT String ParserState m [String] -getTypeNames = do - return [] diff --git a/ubcc.cabal b/ubcc.cabal index 5214694..5ccb58e 100644 --- a/ubcc.cabal +++ b/ubcc.cabal @@ -25,21 +25,16 @@ source-repository head library exposed-modules: - Ubc.Parse Ubc.Parse.Syntax.Config Ubc.Parse.Syntax.Data.Struct Ubc.Parse.Syntax.Expression Ubc.Parse.Syntax.File Ubc.Parse.Syntax.Function Ubc.Parse.Syntax.Language - Ubc.Parse.Syntax.ParserState - Ubc.Parse.Syntax.Scope - Ubc.Parse.Syntax.Scope.FileScope - Ubc.Parse.Syntax.Scope.StructScope + Ubc.Parse.Syntax.Operators Ubc.Parse.Syntax.Statement Ubc.Parse.Syntax.Struct Ubc.Parse.Syntax.TypeExpression - Ubc.Parse.Syntax.Types Ubc.Parse.Syntax.VariableType other-modules: Paths_ubcc