74 lines
2.3 KiB
Haskell
74 lines
2.3 KiB
Haskell
{-# LANGUAGE DerivingVia #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Ubc.Parse.Syntax.Struct
|
|
( Struct(..)
|
|
, parse
|
|
)
|
|
where
|
|
|
|
-- yay, explicit dependency on ghc
|
|
import GHC.Generics (Generic, Generically(..))
|
|
|
|
import Control.Monad ((<$!>))
|
|
|
|
import Text.Parsec
|
|
( choice,
|
|
many,
|
|
try,
|
|
ParsecT,
|
|
)
|
|
|
|
import Ubc.Parse.Syntax.VariableType (VariableType)
|
|
|
|
import Ubc.Parse.Syntax.Function (Function)
|
|
|
|
import qualified Ubc.Parse.Syntax.Language as UbcLanguage
|
|
import qualified Ubc.Parse.Syntax.VariableType as VariableType
|
|
import qualified Ubc.Parse.Syntax.Function as Function
|
|
import qualified Ubc.Parse.Syntax.Generic as Syntax.Generic
|
|
import Ubc.Parse.Syntax (Token)
|
|
|
|
type VariableName = Token
|
|
|
|
data Struct = Struct
|
|
{ name :: Token
|
|
, generics :: [Syntax.Generic.Generic]
|
|
, body :: StructBody
|
|
}
|
|
deriving (Show)
|
|
|
|
data StructBody = StructBody
|
|
{ variables :: [(VariableName, VariableType)]
|
|
, functions :: [Function]
|
|
}
|
|
deriving stock (Generic, Show)
|
|
deriving (Semigroup, Monoid) via Generically StructBody
|
|
|
|
parse :: Monad m => ParsecT Token u m Struct
|
|
parse = do
|
|
_ <- UbcLanguage.reserved "struct"
|
|
structIdentifier <- UbcLanguage.identifier
|
|
structGenerics <- UbcLanguage.angles $ UbcLanguage.commaSeparated1 Syntax.Generic.parse
|
|
structBody <- mconcat <$!> UbcLanguage.braces (many structMember)
|
|
|
|
pure $ Struct structIdentifier structGenerics structBody
|
|
|
|
structMember :: Monad m => ParsecT Token u m StructBody
|
|
structMember = choice [ structVariableOrFunction ]
|
|
|
|
structVariableOrFunction :: Monad m => ParsecT Token u m StructBody
|
|
structVariableOrFunction = do
|
|
(typeName, identifier) <- try $ do
|
|
typeName <- UbcLanguage.typeName
|
|
objectIdentifier <- UbcLanguage.identifier
|
|
return (VariableType.fromString typeName, objectIdentifier)
|
|
choice
|
|
[ parseVariable typeName identifier
|
|
, (\ f -> mempty { functions = [f] }) <$!> Function.parsePrefixed typeName identifier
|
|
]
|
|
|
|
parseVariable :: Monad m => VariableType -> Token -> ParsecT Token u m StructBody
|
|
parseVariable variableType variableName = do
|
|
_ <- UbcLanguage.semicolon
|
|
return $ mempty { variables = [(variableName, variableType)] }
|