Collecting the body of structs with monoids

This commit is contained in:
VegOwOtenks 2025-02-13 21:45:02 +01:00
parent 2b4e5fcdc0
commit 4e8e5b9e84

View file

@ -1,9 +1,14 @@
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DeriveGeneric #-}
module Ubc.Parse.Syntax.Struct
( Struct(..)
, parse
)
where
-- yay, explicit dependency on ghc
import GHC.Generics (Generic)
import Control.Monad ((<$!>))
import Text.Parsec
@ -23,37 +28,31 @@ import qualified Ubc.Parse.Syntax.Function as Function
type VariableName = String
data StructStatement = Variable VariableName VariableType
| Function Function.Function
data Struct = Struct
data Struct = Struct
{ name :: String
, variables :: [(VariableName, VariableType)]
, functions :: [Function]
, body :: StructBody
}
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)
data StructBody = StructBody
{ variables :: [(VariableName, VariableType)]
, functions :: [Function]
}
deriving stock (Generic, Show)
deriving (Semigroup, Monoid) via StructBody
parse :: Monad m => ParsecT String u m Struct
parse = do
_ <- UbcLanguage.reserved "struct"
structIdentifier <- UbcLanguage.identifier
structBody <- mconcat <$!> UbcLanguage.braces (many structMember)
foldl accumulateStruct (Struct structIdentifier [] []) <$!> UbcLanguage.braces (many structMember)
pure $ Struct structIdentifier structBody
accumulateStruct :: Struct -> StructStatement -> Struct
accumulateStruct s (Variable n t) = addVariable s n t
accumulateStruct s (Function f) = addFunction s f
structMember :: Monad m => ParsecT String u m StructStatement
structMember :: Monad m => ParsecT String u m StructBody
structMember = choice [ structVariableOrFunction ]
structVariableOrFunction :: Monad m => ParsecT String u m StructStatement
structVariableOrFunction :: Monad m => ParsecT String u m StructBody
structVariableOrFunction = do
(typeName, identifier) <- try $ do
typeName <- UbcLanguage.typeName
@ -61,10 +60,10 @@ structVariableOrFunction = do
return (VariableType.fromString typeName, objectIdentifier)
choice
[ parseVariable typeName identifier
, Function <$!> Function.parsePrefixed typeName identifier
] -- TODO: Functions on structs
, (\ f -> mempty { functions = [f] }) <$!> Function.parsePrefixed typeName identifier
]
parseVariable :: Monad m => VariableType -> String -> ParsecT String u m StructStatement
parseVariable :: Monad m => VariableType -> String -> ParsecT String u m StructBody
parseVariable variableType variableName = do
_ <- UbcLanguage.semicolon
return $ Variable variableName variableType
return $ mempty { variables = [(variableName, variableType)] }