VegOwOtenks/ubcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Simple parse-dump main function, also fixed about everything

Browse source
This commit is contained in:
VegOwOtenks 2025-01-25 20:55:26 +01:00
parent f35ca83d7a
commit 01fafec1c0
18 changed files with 179 additions and 214 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
app/Main.hs
View file

@ -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 "<stdin>" text

15
src/Ubc/Parse.hs
View file

@ -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 ()

13
src/Ubc/Parse/Syntax/Data/Struct.hs
View file

@ -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)

41
src/Ubc/Parse/Syntax/Expression.hs
View file

@ -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

18
src/Ubc/Parse/Syntax/Expression.hs-boot Normal file
View file

@ -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

42
src/Ubc/Parse/Syntax/File.hs
View file

@ -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
]

23
src/Ubc/Parse/Syntax/Function.hs
View file

@ -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

29
src/Ubc/Parse/Syntax/Operators.hs Normal file
View file

@ -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)

28
src/Ubc/Parse/Syntax/ParserState.hs
View file

@ -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}

16
src/Ubc/Parse/Syntax/Scope.hs
View file

@ -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"

11
src/Ubc/Parse/Syntax/Scope/FileScope.hs
View file

@ -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
}

19
src/Ubc/Parse/Syntax/Scope/StructScope.hs
View file

@ -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

21
src/Ubc/Parse/Syntax/Statement.hs
View file

@ -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

4
src/Ubc/Parse/Syntax/Statement.hs-boot Normal file
View file

@ -0,0 +1,4 @@
module Ubc.Parse.Syntax.Statement
where
data Statement

65
src/Ubc/Parse/Syntax/Struct.hs
View file

@ -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

15
src/Ubc/Parse/Syntax/TypeExpression.hs
View file

@ -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
]

21
src/Ubc/Parse/Syntax/Types.hs
View file

@ -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 []

7
ubcc.cabal
View file

@ -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