Collecting the body of structs with monoids
This commit is contained in:
parent
2b4e5fcdc0
commit
4e8e5b9e84
1 changed files with 21 additions and 22 deletions
|
@ -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)] }
|
||||
|
|
Loading…
Reference in a new issue