Compare commits

..

2 commits

Author SHA1 Message Date
c12458a2bf Fixed the infinite loop 2025-02-13 23:39:17 +01:00
b87917dc2e Monoids for File construction 2025-02-13 21:56:22 +01:00
3 changed files with 25 additions and 27 deletions

View file

@ -6,4 +6,4 @@ main :: IO ()
main = do main = do
text <- getContents text <- getContents
print $ Parsec.parse (File.parse <* Parsec.eof) "<stdin>" text print $ Parsec.parse (File.parse "<stdin>" <* Parsec.eof) "<stdin>" text

View file

@ -1,3 +1,5 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
module Ubc.Parse.Syntax.File module Ubc.Parse.Syntax.File
( File(..) ( File(..)
, parse , parse
@ -17,36 +19,32 @@ import qualified Ubc.Parse.Syntax.Struct as Struct
import qualified Ubc.Parse.Syntax.Function as Function import qualified Ubc.Parse.Syntax.Function as Function
import qualified Ubc.Parse.Syntax.Statement as Statement import qualified Ubc.Parse.Syntax.Statement as Statement
import qualified Ubc.Parse.Syntax.Enumeration as Enumeration import qualified Ubc.Parse.Syntax.Enumeration as Enumeration
import GHC.Generics (Generic, Generically(..))
import Data.Functor ((<&>))
data File = File data File = File
{ name :: String { name :: String
, structs :: [Struct] , body :: FileBody
}
deriving (Show)
data FileBody = FileBody
{ structs :: [Struct]
, functions :: [Function] , functions :: [Function]
, statements :: [Statement] , statements :: [Statement]
, enumerations :: [Enumeration] , enumerations :: [Enumeration]
} }
deriving (Show) deriving stock (Show, Generic)
deriving (Semigroup, Monoid) via Generically FileBody
-- dont use `deriving ... via FileBody` because that leads to a loop, somehow
data FileMember = FileFunction Function parse :: Monad m => String -> ParsecT String u m File
| FileStruct Struct parse source = File source <$!> mconcat <$!> many fileMember
| FileEnumeration Enumeration
| FileStatement Statement
accumulateFile :: File -> FileMember -> File fileMember :: Monad m => ParsecT String u m FileBody
accumulateFile (File name_ sss fs sts es) (FileStruct s) = File name_ (s:sss) fs sts es fileMember = choice
accumulateFile (File name_ sss fs sts es) (FileFunction f) = File name_ sss (f:fs) sts es [ Struct.parse <&> \s -> mempty { structs = [s] }
accumulateFile (File name_ sss fs sts es) (FileStatement s) = File name_ sss fs (s:sts) es , Function.parse <&> \f -> mempty { functions = [f] }
accumulateFile (File name_ sss fs sts es) (FileEnumeration e) = File name_ sss fs sts (e:es) , Statement.parse <&> \s -> mempty { statements = [s] }
, Enumeration.parse <&> \e -> mempty { enumerations = [e] }
parse :: Monad m => ParsecT String u m File
parse = foldr (flip accumulateFile) (File "" [] [] [] []) <$!> many fileMember
fileMember :: Monad m => ParsecT String u m FileMember
fileMember = choice
[ FileStruct <$!> Struct.parse
, FileFunction <$!> Function.parse
, FileStatement <$!> Statement.parse
, FileEnumeration <$!> Enumeration.parse
] ]

View file

@ -7,7 +7,7 @@ module Ubc.Parse.Syntax.Struct
where where
-- yay, explicit dependency on ghc -- yay, explicit dependency on ghc
import GHC.Generics (Generic) import GHC.Generics (Generic, Generically(..))
import Control.Monad ((<$!>)) import Control.Monad ((<$!>))
@ -39,7 +39,7 @@ data StructBody = StructBody
, functions :: [Function] , functions :: [Function]
} }
deriving stock (Generic, Show) deriving stock (Generic, Show)
deriving (Semigroup, Monoid) via StructBody deriving (Semigroup, Monoid) via Generically StructBody
parse :: Monad m => ParsecT String u m Struct parse :: Monad m => ParsecT String u m Struct
parse = do parse = do