diff --git a/app/Main.hs b/app/Main.hs index 98700ca..0f4e265 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -6,7 +6,6 @@ import System.Directory as Directory import qualified Control.Monad.Trans.Reader as Reader import qualified Data.Set as Set -import qualified Data.Text.IO as Text.IO import qualified Text.Parsec as Parsec @@ -23,7 +22,7 @@ minimalConfig = do main :: IO () main = do - text <- Text.IO.getContents + text <- getContents -- fixme: handle errors? parseConfig <- minimalConfig diff --git a/package.yaml b/package.yaml index 47a2844..113d1ab 100644 --- a/package.yaml +++ b/package.yaml @@ -29,7 +29,6 @@ dependencies: - os-string - path - parsec -- text - transformers ghc-options: diff --git a/src/Ubc/Parse/Syntax.hs b/src/Ubc/Parse/Syntax.hs index 2225c9e..9afeb5a 100644 --- a/src/Ubc/Parse/Syntax.hs +++ b/src/Ubc/Parse/Syntax.hs @@ -1,12 +1,7 @@ module Ubc.Parse.Syntax -(Transformer, Token) +(Transformer) where - import Control.Monad.Reader (ReaderT) - -import Data.Text ( Text ) - import Ubc.Parse.Syntax.Config (Config) type Transformer = ReaderT Config IO -type Token = Text diff --git a/src/Ubc/Parse/Syntax/Enumeration.hs b/src/Ubc/Parse/Syntax/Enumeration.hs index 3ac1b53..bcba92a 100644 --- a/src/Ubc/Parse/Syntax/Enumeration.hs +++ b/src/Ubc/Parse/Syntax/Enumeration.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} module Ubc.Parse.Syntax.Enumeration ( Enumeration(..) , parse @@ -8,17 +7,15 @@ where import Text.Parsec (ParsecT, many, ()) import qualified Ubc.Parse.Syntax.Language as UbcLanguage -import Ubc.Parse.Syntax (Token) -import Data.Text (Text) -type EnumerationMember = Token +type EnumerationMember = String data Enumeration = Enumeration - { name :: Text + { name :: String , members :: [EnumerationMember] } deriving (Show) -parse :: Monad m => ParsecT Token u m Enumeration +parse :: Monad m => ParsecT String u m Enumeration parse = do UbcLanguage.reserved "enum" identifier <- UbcLanguage.identifier "enum identifier" diff --git a/src/Ubc/Parse/Syntax/Expression.hs b/src/Ubc/Parse/Syntax/Expression.hs index 4de46a8..55dc542 100644 --- a/src/Ubc/Parse/Syntax/Expression.hs +++ b/src/Ubc/Parse/Syntax/Expression.hs @@ -1,8 +1,6 @@ -{-# LANGUAGE OverloadedStrings #-} module Ubc.Parse.Syntax.Expression ( Expression(..) , expressionParser -, blockExpression ) where @@ -11,32 +9,27 @@ import Data.Functor ( (<&>), ($>) ) import Data.Ratio ((%)) import Text.Parsec.Expr (Operator(Infix, Prefix), Assoc (AssocLeft, AssocRight), buildExpressionParser) -import Text.Parsec (ParsecT, (<|>), (), choice, option, many1, digit, lookAhead, oneOf, char, notFollowedBy, many) +import Text.Parsec (ParsecT, (<|>), (), choice, option, many1, digit, lookAhead, oneOf, char, notFollowedBy) -import Ubc.Parse.Syntax.Statement (Statement) +import Ubc.Parse.Syntax.Statement (blockExpression, Statement) import Ubc.Parse.Syntax.Operators (BinaryOperator(..), UnaryOperator (..)) import qualified Ubc.Parse.Syntax.Language as UbcLanguage -import Ubc.Parse.Syntax (Token) -import qualified Ubc.Parse.Syntax.Statement as Statement data Expression = Binary BinaryOperator Expression Expression | Unary UnaryOperator Expression | ConstantInteger Integer | ConstantFraction Rational - | FunctionCall Token [Expression] - | Variable Token + | FunctionCall String [Expression] + | Variable String | If Expression Expression (Maybe Expression) -- if then else | Loop Expression Expression -- condition body | Block [Statement] deriving (Show) -operatorTable :: Monad m => [[Operator Token u m Expression]] +operatorTable :: Monad m => [[Operator String u m Expression]] operatorTable = [ - [ Infix (UbcLanguage.reservedOperator "." $> Binary StructureAccess) AssocLeft - ] - , [ Infix (UbcLanguage.reservedOperator "*" $> Binary Multiply) AssocLeft , Infix (UbcLanguage.reservedOperator "/" $> Binary Divide) AssocLeft , Infix (UbcLanguage.reservedOperator "%" $> Binary Modulo) AssocLeft @@ -70,10 +63,10 @@ operatorTable = , [ Infix (UbcLanguage.reservedOperator "=" $> Binary Assign) AssocRight ] ] -expressionParser :: (Monad m) => ParsecT Token u m Expression +expressionParser :: (Monad m) => ParsecT String u m Expression expressionParser = buildExpressionParser operatorTable termParser "expression" -numberTerm :: Monad m => ParsecT Token u m Expression +numberTerm :: Monad m => ParsecT String u m Expression numberTerm = do notFollowedBy $ char '0' integerDigits <- many1 digit @@ -83,7 +76,7 @@ numberTerm = do ] <* UbcLanguage.whiteSpace -decimalTerm :: Monad m => [Char] -> ParsecT Token u m Expression +decimalTerm :: Monad m => [Char] -> ParsecT String u m Expression decimalTerm integerDigits = do _ <- lookAhead $ oneOf "e." fractionalDigits <- option "" $ char '.' *> many1 digit @@ -96,7 +89,7 @@ decimalTerm integerDigits = do return $ ConstantFraction $ numeratorInteger ^ numeratorPower % denominatorInteger ^ denominatorPower -termParser :: Monad m => ParsecT Token u m Expression +termParser :: Monad m => ParsecT String u m Expression termParser = UbcLanguage.parens expressionParser <|> numberTerm <|> fmap ConstantInteger UbcLanguage.integer @@ -108,13 +101,13 @@ termParser = UbcLanguage.parens expressionParser <|> functionCallOrVariable "term" -loopExpression :: Monad m => String -> (Expression -> Expression) -> ParsecT Token u m Expression +loopExpression :: Monad m => String -> (Expression -> Expression) -> ParsecT String u m Expression loopExpression startKeyword conditionWrapper = do _ <- UbcLanguage.reserved startKeyword condition <- conditionWrapper <$!> expressionParser Loop condition <$> expressionParser -conditionalExpression :: Monad m => String -> (Expression -> Expression) -> ParsecT Token u m Expression +conditionalExpression :: Monad m => String -> (Expression -> Expression) -> ParsecT String u m Expression conditionalExpression startKeyword conditionWrapper = do _ <- UbcLanguage.reserved startKeyword condition <- conditionWrapper <$!> expressionParser @@ -124,7 +117,7 @@ conditionalExpression startKeyword conditionWrapper = do return $ If condition then_ else_ -functionCallOrVariable :: Monad m => ParsecT Token u m Expression +functionCallOrVariable :: Monad m => ParsecT String u m Expression functionCallOrVariable = do name <- UbcLanguage.identifier choice @@ -132,5 +125,3 @@ functionCallOrVariable = do , return $ Variable name ] -blockExpression :: Monad m => ParsecT Token u m Expression -blockExpression = UbcLanguage.braces (many Statement.parse) <&> Block diff --git a/src/Ubc/Parse/Syntax/Expression.hs-boot b/src/Ubc/Parse/Syntax/Expression.hs-boot index a9b7022..6375669 100644 --- a/src/Ubc/Parse/Syntax/Expression.hs-boot +++ b/src/Ubc/Parse/Syntax/Expression.hs-boot @@ -1,14 +1,21 @@ module Ubc.Parse.Syntax.Expression -( Expression +( Expression(..) , expressionParser -, blockExpression ) where import Text.Parsec (ParsecT) -import Ubc.Parse.Syntax (Token) +import Ubc.Parse.Syntax.Operators (BinaryOperator, UnaryOperator) +import {-# SOURCE #-} Ubc.Parse.Syntax.Statement (Statement) -data Expression +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 Token u m Expression -blockExpression :: Monad m => ParsecT Token u m Expression +expressionParser :: Monad m => ParsecT String u m Expression diff --git a/src/Ubc/Parse/Syntax/File.hs b/src/Ubc/Parse/Syntax/File.hs index 000f663..db7d116 100644 --- a/src/Ubc/Parse/Syntax/File.hs +++ b/src/Ubc/Parse/Syntax/File.hs @@ -11,13 +11,9 @@ import GHC.Generics (Generic, Generically(..)) import Control.Monad ((<$!>)) import Data.Functor ((<&>)) -import qualified Data.Text as Text - import Text.Parsec (choice, ParsecT, many) -import qualified Text.Parsec as Parsec - -import Ubc.Parse.Syntax (Transformer, Token) +import Ubc.Parse.Syntax (Transformer) import {-# SOURCE #-} Ubc.Parse.Syntax.Import (Import) import Ubc.Parse.Syntax.Struct (Struct) @@ -30,9 +26,10 @@ import qualified Ubc.Parse.Syntax.Struct as Struct import qualified Ubc.Parse.Syntax.Function as Function import qualified Ubc.Parse.Syntax.Statement as Statement import qualified Ubc.Parse.Syntax.Enumeration as Enumeration +import qualified Text.Parsec as Parsec data File = File - { name :: Token + { name :: String , body :: FileBody } deriving (Show) @@ -48,13 +45,13 @@ data FileBody = FileBody deriving (Semigroup, Monoid) via Generically FileBody -- dont use `deriving ... via FileBody` because that leads to a loop, somehow -parse :: ParsecT Token u Transformer File +parse :: ParsecT String u Transformer File parse = do - fileName <- Text.pack . Parsec.sourceName <$!> Parsec.getPosition + fileName <- Parsec.sourceName <$!> Parsec.getPosition fileBody <- mconcat <$!> many fileMember pure $ File fileName fileBody -fileMember :: ParsecT Token u Transformer FileBody +fileMember :: ParsecT String u Transformer FileBody fileMember = choice [ Struct.parse <&> \s -> mempty { structs = [s] } , Import.parse <&> \i -> mempty { imports = [i] } diff --git a/src/Ubc/Parse/Syntax/File.hs-boot b/src/Ubc/Parse/Syntax/File.hs-boot index 108dc4c..72b1dd6 100644 --- a/src/Ubc/Parse/Syntax/File.hs-boot +++ b/src/Ubc/Parse/Syntax/File.hs-boot @@ -6,10 +6,10 @@ where import Text.Parsec (ParsecT) -import Ubc.Parse.Syntax (Transformer, Token) +import Ubc.Parse.Syntax (Transformer) data File instance Show File -parse :: ParsecT Token u Transformer File +parse :: ParsecT String u Transformer File diff --git a/src/Ubc/Parse/Syntax/Function.hs b/src/Ubc/Parse/Syntax/Function.hs index 770a900..ab8053a 100644 --- a/src/Ubc/Parse/Syntax/Function.hs +++ b/src/Ubc/Parse/Syntax/Function.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} module Ubc.Parse.Syntax.Function ( Function(..) , parse @@ -13,32 +12,26 @@ import Text.Parsec (lookAhead, try, ParsecT) import Ubc.Parse.Syntax.VariableType (VariableType) import {-# SOURCE #-} Ubc.Parse.Syntax.Expression (Expression, expressionParser) -import Ubc.Parse.Syntax.Generic (Generic) import qualified Ubc.Parse.Syntax.Language as UbcLanguage import qualified Ubc.Parse.Syntax.VariableType as VariableType -import qualified Ubc.Parse.Syntax.Generic as Generic -import Ubc.Parse.Syntax (Token) data Function = Function - { returnType :: VariableType - , identifier :: Token - , generics :: [Generic] + { identifier :: String + , returnType :: VariableType , body :: Expression - , arguments :: [(VariableType, Token)] + , arguments :: [(VariableType, String)] } deriving (Show) -parsePrefixed :: Monad m => VariableType -> Token -> ParsecT Token u m Function +parsePrefixed :: Monad m => VariableType -> String -> ParsecT String u m Function parsePrefixed ftype fname = do - genericList <- UbcLanguage.angles $ UbcLanguage.commaSeparated1 Generic.parse - argumentList <- UbcLanguage.parens (UbcLanguage.commaSeparated argumentDefinition) expressionBody <- expressionParser - return $ Function ftype fname genericList expressionBody argumentList + return $ Function fname ftype expressionBody argumentList -parse :: Monad m => ParsecT Token u m Function +parse :: Monad m => ParsecT String u m Function parse = do (resultType, name) <- try $ do resultType <- UbcLanguage.typeName @@ -48,7 +41,7 @@ parse = do parsePrefixed resultType name -argumentDefinition :: Monad m => ParsecT Token u m (VariableType, Token) +argumentDefinition :: Monad m => ParsecT String u m (VariableType, String) argumentDefinition = do argumentType <- VariableType.fromString <$!> UbcLanguage.typeName argumentName <- UbcLanguage.identifier diff --git a/src/Ubc/Parse/Syntax/Generic.hs b/src/Ubc/Parse/Syntax/Generic.hs deleted file mode 100644 index 9cfb465..0000000 --- a/src/Ubc/Parse/Syntax/Generic.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE DerivingStrategies #-} -module Ubc.Parse.Syntax.Generic -( Generic(..) -, parse -) -where - -import qualified Ubc.Parse.Syntax.Language as Language -import Control.Monad ((<$!>)) -import Text.Parsec (ParsecT) -import Ubc.Parse.Syntax (Token) - -data Generic = Generic - { name :: Token - } - deriving stock (Show) - -parse :: Monad m => ParsecT Token u m Generic -parse = Generic <$!> Language.identifier diff --git a/src/Ubc/Parse/Syntax/Import.hs b/src/Ubc/Parse/Syntax/Import.hs index a92703c..d061b52 100644 --- a/src/Ubc/Parse/Syntax/Import.hs +++ b/src/Ubc/Parse/Syntax/Import.hs @@ -1,6 +1,5 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE OverloadedStrings #-} module Ubc.Parse.Syntax.Import ( parse , Import(..) @@ -19,19 +18,17 @@ import Data.Functor ((<&>)) import Data.List.NonEmpty (NonEmpty) import qualified Data.List as List -import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Set as Set -import qualified Data.Text as Text -import qualified Data.Text.IO as Text.IO +import qualified Data.List.NonEmpty as NonEmpty import qualified System.Directory as IO -import Text.Parsec (sepBy1, ParsecT, anyChar, many, char, choice, notFollowedBy, oneOf) +import Text.Parsec (sepBy1, ParsecT, anyChar, many, char, choice, notFollowedBy, oneOf, option) import qualified Text.Parsec as Parsec import Path as Path ( Path, File, parseRelFile, Rel, parseRelDir, Dir, Abs, (), fromAbsFile, fromRelFile ) -import Ubc.Parse.Syntax (Transformer, Token) +import Ubc.Parse.Syntax (Transformer) import Ubc.Parse.Syntax.Config (Config) import qualified Ubc.Parse.Syntax.Config as Config import qualified Ubc.Parse.Syntax.File as File @@ -39,22 +36,21 @@ import qualified Ubc.Parse.Syntax.Language as UbcLanguage data Import = Import { file :: File.File - , alias :: Maybe Token - , list :: [Token] + , alias :: String } deriving stock (Show) -importPath :: Monad m => ParsecT Token u m (NonEmpty Token) +importPath :: Monad m => ParsecT String u m (NonEmpty String) importPath = UbcLanguage.angles (many importChar `sepBy1` char '/') - <&> NonEmpty.fromList . List.map Text.pack + <&> NonEmpty.fromList -importChar :: (Monad m) => ParsecT Token u m Char +importChar :: (Monad m) => ParsecT String u m Char importChar = choice [ char '\\' >> oneOf ">/\\" , notFollowedBy (oneOf ">/") >> anyChar ] -parse :: ParsecT Token u Transformer Import +parse :: ParsecT String u Transformer Import parse = do UbcLanguage.reserved "import" fragments <- importPath @@ -71,34 +67,32 @@ parse = do -- fail or parse importedFile <- case existingFiles of - [] -> fail . Text.unpack $ notFoundMessage relFile possiblePaths + [] -> fail $ notFoundMessage relFile possiblePaths [path] -> parseFile path - fs@_ -> fail . Text.unpack $ multipleFoundMessage relFile fs + fs@_ -> fail $ multipleFoundMessage relFile fs - importAs <- Parsec.optionMaybe importAlias + importAs <- Parsec.parserTraced "alias" $ option (NonEmpty.last fragments) importAlias - importList <- UbcLanguage.parens $ UbcLanguage.commaSeparated UbcLanguage.identifier + return $ Import importedFile importAs - return $ Import importedFile importAs importList - -importAlias :: Monad m => ParsecT Token u m Token +importAlias :: Monad m => ParsecT String u m String importAlias = UbcLanguage.reserved "as" *> UbcLanguage.identifier -multipleFoundMessage :: Path Rel File -> [Path Abs File] -> Token -multipleFoundMessage relFile foundFiles = "Could not identify imported file " <> Text.pack (Path.fromRelFile relFile) <> "\n" +multipleFoundMessage :: Path Rel File -> [Path Abs File] -> String +multipleFoundMessage relFile foundFiles = "Could not identify imported file " <> Path.fromRelFile relFile <> "\n" <> "Found multiple files in the search path:" - <> (Text.unlines . List.map (Path.fromAbsFile >>> ('\t':) >>> Text.pack) $ foundFiles) + <> (unlines . List.map (Path.fromAbsFile >>> ('\t':)) $ foundFiles) -notFoundMessage :: Path Rel File -> [Path Abs File] -> Token -notFoundMessage relFile searchedLocations = "Could not locate import file <" <> Text.pack (Path.fromRelFile relFile) <> ">\n" +notFoundMessage :: Path Rel File -> [Path Abs File] -> String +notFoundMessage relFile searchedLocations = "Could not locate import file <" <> Path.fromRelFile relFile <> ">\n" <> "Searched locations were:\n" - <> (Text.unlines . List.map (Path.fromAbsFile >>> ('\t':) >>> Text.pack) $ searchedLocations) + <> (unlines . List.map (('\t':) . Path.fromAbsFile) $ searchedLocations) -parseFile :: Path Abs File -> ParsecT Token u Transformer File.File +parseFile :: Path Abs File -> ParsecT String u Transformer File.File parseFile path = do let stringPath = Path.fromAbsFile path - contents <- liftIO . Text.IO.readFile $ stringPath + contents <- liftIO . readFile $ stringPath -- save old state oldInput <- Parsec.getInput @@ -126,10 +120,10 @@ parseFile path = do pure importedFile -parseRelPath :: MonadThrow m => NonEmpty Token -> m (Path Rel File) +parseRelPath :: MonadThrow m => NonEmpty FilePath -> m (Path Rel File) parseRelPath fragments = do - name <- Path.parseRelFile . Text.unpack $ NonEmpty.last fragments - dirPath <- mapM (Path.parseRelDir . Text.unpack) . NonEmpty.init $ fragments + name <- Path.parseRelFile $ NonEmpty.last fragments + dirPath <- mapM Path.parseRelDir . NonEmpty.init $ fragments pure $ constructRelative name dirPath constructRelative :: Path Rel t -> [Path Rel Dir] -> Path Rel t diff --git a/src/Ubc/Parse/Syntax/Import.hs-boot b/src/Ubc/Parse/Syntax/Import.hs-boot index fd7b1ac..2878d0a 100644 --- a/src/Ubc/Parse/Syntax/Import.hs-boot +++ b/src/Ubc/Parse/Syntax/Import.hs-boot @@ -6,10 +6,10 @@ where import Text.Parsec (ParsecT) -import Ubc.Parse.Syntax (Transformer, Token) +import Ubc.Parse.Syntax (Transformer) data Import instance Show Import -parse :: ParsecT Token u Transformer Import +parse :: ParsecT String u Transformer Import diff --git a/src/Ubc/Parse/Syntax/Language.hs b/src/Ubc/Parse/Syntax/Language.hs index bc9b679..b82eb97 100644 --- a/src/Ubc/Parse/Syntax/Language.hs +++ b/src/Ubc/Parse/Syntax/Language.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoMonomorphismRestriction #-} module Ubc.Parse.Syntax.Language ( languageDef @@ -34,24 +33,19 @@ module Ubc.Parse.Syntax.Language ) where -import Data.Functor ( ($>), (<&>) ) -import qualified Data.Text as Text - +import Data.Functor ( ($>) ) import Text.Parsec ( alphaNum, char, letter, oneOf, choice, (<|>), ParsecT ) import Text.Parsec.Token ( makeTokenParser, GenLanguageDef(..), - GenTokenParser(TokenParser, - charLiteral, natural, integer, float, - naturalOrFloat, decimal, hexadecimal, octal, lexeme, - whiteSpace, parens, braces, angles, brackets, - semiSep, semiSep1, commaSep, commaSep1) ) -import qualified Text.Parsec.Token as Token + GenTokenParser(TokenParser, identifier, reserved, operator, + reservedOp, charLiteral, stringLiteral, natural, integer, float, + naturalOrFloat, decimal, hexadecimal, octal, symbol, lexeme, + whiteSpace, parens, braces, angles, brackets, semi, comma, colon, + dot, semiSep, semiSep1, commaSep, commaSep1) ) -import Ubc.Parse.Syntax (Token) - -languageDef :: Monad m => GenLanguageDef Token u m +languageDef :: Monad m => GenLanguageDef String u m languageDef = LanguageDef { commentStart = "/*" , commentEnd = "*/" @@ -98,29 +92,44 @@ languageDef = LanguageDef { , caseSensitive = True } -tokenParser :: Monad m => GenTokenParser Token u m +tokenParser :: Monad m => GenTokenParser String u m tokenParser = makeTokenParser languageDef -characterLiteral :: Monad m => ParsecT Token u m Char -natural :: Monad m => ParsecT Token u m Integer -integer :: Monad m => ParsecT Token u m Integer -float :: Monad m => ParsecT Token u m Double -naturalOrFloat :: Monad m => ParsecT Token u m (Either Integer Double) -decimal :: Monad m => ParsecT Token u m Integer -hexadecimal :: Monad m => ParsecT Token u m Integer -octal :: Monad m => ParsecT Token u m Integer -lexeme :: Monad m => ParsecT Token u m a -> ParsecT Token u m a -whiteSpace :: Monad m => ParsecT Token u m () -parens :: Monad m => ParsecT Token u m a -> ParsecT Token u m a -braces :: Monad m => ParsecT Token u m a -> ParsecT Token u m a -angles :: Monad m => ParsecT Token u m a -> ParsecT Token u m a -brackets :: Monad m => ParsecT Token u m a -> ParsecT Token u m a -semicolonSeparated :: Monad m => ParsecT Token u m a -> ParsecT Token u m [a] -semicolonSeparated1 :: Monad m => ParsecT Token u m a -> ParsecT Token u m [a] -commaSeparated :: Monad m => ParsecT Token u m a -> ParsecT Token u m [a] -commaSeparated1 :: Monad m => ParsecT Token u m a -> ParsecT Token u m [a] +identifier :: Monad m => ParsecT String u m String +reserved :: Monad m => String -> ParsecT String u m () +operator :: Monad m => ParsecT String u m String +reservedOperator :: Monad m => String -> ParsecT String u m () +characterLiteral :: Monad m => ParsecT String u m Char +stringLiteral :: Monad m => ParsecT String u m String +natural :: Monad m => ParsecT String u m Integer +integer :: Monad m => ParsecT String u m Integer +float :: Monad m => ParsecT String u m Double +naturalOrFloat :: Monad m => ParsecT String u m (Either Integer Double) +decimal :: Monad m => ParsecT String u m Integer +hexadecimal :: Monad m => ParsecT String u m Integer +octal :: Monad m => ParsecT String u m Integer +symbol :: Monad m => String -> ParsecT String u m String +lexeme :: Monad m => ParsecT String u m a -> ParsecT String u m a +whiteSpace :: Monad m => ParsecT String u m () +parens :: Monad m => ParsecT String u m a -> ParsecT String u m a +braces :: Monad m => ParsecT String u m a -> ParsecT String u m a +angles :: Monad m => ParsecT String u m a -> ParsecT String u m a +brackets :: Monad m => ParsecT String u m a -> ParsecT String u m a +semicolon :: Monad m => ParsecT String u m String +comma :: Monad m => ParsecT String u m String +colon :: Monad m => ParsecT String u m String +dot :: Monad m => ParsecT String u m String +semicolonSeparated :: Monad m => ParsecT String u m a -> ParsecT String u m [a] +semicolonSeparated1 :: Monad m => ParsecT String u m a -> ParsecT String u m [a] +commaSeparated :: Monad m => ParsecT String u m a -> ParsecT String u m [a] +commaSeparated1 :: Monad m => ParsecT String u m a -> ParsecT String u m [a] TokenParser{ - charLiteral = characterLiteral + identifier = identifier + , reserved = reserved + , operator = operator + , reservedOp = reservedOperator + , charLiteral = characterLiteral + , stringLiteral = stringLiteral , natural = natural -- decimal, hexadecimal or octal , integer = integer -- decimal, hexadecimal or octal , float = float @@ -128,49 +137,24 @@ TokenParser{ , decimal = decimal , hexadecimal = hexadecimal , octal = octal + , symbol = symbol , lexeme = lexeme , whiteSpace = whiteSpace , parens = parens , braces = braces , angles = angles , brackets = brackets + , semi = semicolon + , comma = comma + , colon = colon + , dot = dot , semiSep = semicolonSeparated , semiSep1 = semicolonSeparated1 , commaSep = commaSeparated , commaSep1 = commaSeparated1 } = tokenParser -semicolon :: Monad m => ParsecT Token u m Token -semicolon = Token.semi tokenParser <&> Text.pack - -comma :: Monad m => ParsecT Token u m Token -comma = Token.comma tokenParser <&> Text.pack - -colon :: Monad m => ParsecT Token u m Token -colon = Token.colon tokenParser <&> Text.pack - -dot :: Monad m => ParsecT Token u m Token -dot = Token.dot tokenParser <&> Text.pack - -symbol :: Monad m => String -> ParsecT Token u m Token -symbol = (<&> Text.pack) . Token.symbol tokenParser - -stringLiteral :: Monad m => ParsecT Token u m Token -stringLiteral = Token.stringLiteral tokenParser <&> Text.pack - -identifier :: Monad m => ParsecT Token u m Token -identifier = Token.identifier tokenParser <&> Text.pack - -reserved :: Monad m => String -> ParsecT Token u m () -reserved = Token.reserved tokenParser - -operator :: Monad m => ParsecT Token u m Token -operator = Token.operator tokenParser <&> Text.pack - -reservedOperator :: Monad m => String -> ParsecT Token u m () -reservedOperator = Token.reservedOp tokenParser - -typeName :: Monad m => ParsecT Token u m Token +typeName :: Monad m => ParsecT String u m String typeName = choice [ Ubc.Parse.Syntax.Language.reserved "i32" $> "i32" , Ubc.Parse.Syntax.Language.reserved "u32" $> "u32" diff --git a/src/Ubc/Parse/Syntax/Operators.hs b/src/Ubc/Parse/Syntax/Operators.hs index 5ae7fe7..435a57b 100644 --- a/src/Ubc/Parse/Syntax/Operators.hs +++ b/src/Ubc/Parse/Syntax/Operators.hs @@ -26,5 +26,4 @@ data BinaryOperator = Plus | LogicAnd | LogicOr | Assign - | StructureAccess deriving (Show) diff --git a/src/Ubc/Parse/Syntax/Statement.hs b/src/Ubc/Parse/Syntax/Statement.hs index 9f08952..20a3231 100644 --- a/src/Ubc/Parse/Syntax/Statement.hs +++ b/src/Ubc/Parse/Syntax/Statement.hs @@ -1,12 +1,12 @@ -{-# LANGUAGE OverloadedStrings #-} module Ubc.Parse.Syntax.Statement ( Statement(..) , parse +, blockExpression ) where import Ubc.Parse.Syntax.VariableType (VariableType) -import {-# SOURCE #-} Ubc.Parse.Syntax.Expression (expressionParser, Expression,) +import {-# SOURCE #-} Ubc.Parse.Syntax.Expression (expressionParser, Expression (Block)) import Ubc.Parse.Syntax.TypeExpression (TypeExpression) import Text.Parsec (choice, ParsecT, try, many) import qualified Ubc.Parse.Syntax.Language as UbcLanguage @@ -14,23 +14,22 @@ import qualified Ubc.Parse.Syntax.VariableType as VariableType import qualified Ubc.Parse.Syntax.TypeExpression as TypeExpression import Control.Monad ((<$!>)) import Data.Functor ((<&>)) -import Ubc.Parse.Syntax (Token) -type VariableName = Token -type TypeName = Token +type VariableName = String +type TypeName = String data Statement = VariableDefinition VariableType VariableName Expression | TypeDefinition TypeName TypeExpression | ExpressionStatement Expression deriving (Show) -parse :: Monad m => ParsecT Token u m Statement +parse :: Monad m => ParsecT String u m Statement parse = choice [ variableDefinition , typeDefinition , ExpressionStatement <$!> expressionParser ] -typeDefinition :: Monad m => ParsecT Token u m Statement +typeDefinition :: Monad m => ParsecT String u m Statement typeDefinition = do UbcLanguage.reserved "type" @@ -41,7 +40,7 @@ typeDefinition = do TypeDefinition name <$> TypeExpression.parseTypeExpression -variableDefinition :: Monad m => ParsecT Token u m Statement +variableDefinition :: Monad m => ParsecT String u m Statement variableDefinition = do (variableType, variableName) <- try $ do variableType <- UbcLanguage.typeName @@ -50,3 +49,6 @@ variableDefinition = do return (VariableType.fromString variableType, variableName) VariableDefinition variableType variableName <$> expressionParser + +blockExpression :: Monad m => ParsecT String u m Expression +blockExpression = UbcLanguage.braces (many parse) <&> Block diff --git a/src/Ubc/Parse/Syntax/Struct.hs b/src/Ubc/Parse/Syntax/Struct.hs index 5631351..c8855b8 100644 --- a/src/Ubc/Parse/Syntax/Struct.hs +++ b/src/Ubc/Parse/Syntax/Struct.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} module Ubc.Parse.Syntax.Struct ( Struct(..) , parse @@ -26,14 +25,11 @@ 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 +type VariableName = String data Struct = Struct - { name :: Token - , generics :: [Syntax.Generic.Generic] + { name :: String , body :: StructBody } deriving (Show) @@ -45,19 +41,18 @@ data StructBody = StructBody deriving stock (Generic, Show) deriving (Semigroup, Monoid) via Generically StructBody -parse :: Monad m => ParsecT Token u m Struct +parse :: Monad m => ParsecT String 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 + pure $ Struct structIdentifier structBody -structMember :: Monad m => ParsecT Token u m StructBody +structMember :: Monad m => ParsecT String u m StructBody structMember = choice [ structVariableOrFunction ] -structVariableOrFunction :: Monad m => ParsecT Token u m StructBody +structVariableOrFunction :: Monad m => ParsecT String u m StructBody structVariableOrFunction = do (typeName, identifier) <- try $ do typeName <- UbcLanguage.typeName @@ -68,7 +63,7 @@ structVariableOrFunction = do , (\ f -> mempty { functions = [f] }) <$!> Function.parsePrefixed typeName identifier ] -parseVariable :: Monad m => VariableType -> Token -> ParsecT Token u m StructBody +parseVariable :: Monad m => VariableType -> String -> ParsecT String u m StructBody parseVariable variableType variableName = do _ <- UbcLanguage.semicolon return $ mempty { variables = [(variableName, variableType)] } diff --git a/src/Ubc/Parse/Syntax/TypeExpression.hs b/src/Ubc/Parse/Syntax/TypeExpression.hs index ce6219d..ad0db90 100644 --- a/src/Ubc/Parse/Syntax/TypeExpression.hs +++ b/src/Ubc/Parse/Syntax/TypeExpression.hs @@ -14,14 +14,13 @@ import Ubc.Parse.Syntax.Struct (Struct) import qualified Ubc.Parse.Syntax.Language as UbcLanguage import qualified Ubc.Parse.Syntax.VariableType as VariableType import qualified Ubc.Parse.Syntax.Struct as Struct -import Ubc.Parse.Syntax (Token) data TypeExpression = TypeAlias VariableType | StructExpression Struct deriving (Show) -parseTypeExpression :: Monad m => ParsecT Token u m TypeExpression +parseTypeExpression :: Monad m => ParsecT String u m TypeExpression parseTypeExpression = choice [ TypeAlias . VariableType.fromString <$!> UbcLanguage.typeName , StructExpression <$!> Struct.parse diff --git a/src/Ubc/Parse/Syntax/VariableType.hs b/src/Ubc/Parse/Syntax/VariableType.hs index 273d2ec..bc71b95 100644 --- a/src/Ubc/Parse/Syntax/VariableType.hs +++ b/src/Ubc/Parse/Syntax/VariableType.hs @@ -1,18 +1,16 @@ -{-# LANGUAGE OverloadedStrings #-} module Ubc.Parse.Syntax.VariableType (VariableType(..) , fromString ) where -import Ubc.Parse.Syntax (Token) data VariableType = BuiltInI32 | BuiltInU32 | BuiltInF32 - | UserStruct Token + | UserStruct String deriving (Show, Eq) -fromString :: Token -> VariableType +fromString :: String -> VariableType fromString "i32" = BuiltInI32 fromString "u32" = BuiltInU32 fromString "f32" = BuiltInF32 diff --git a/ubcc.cabal b/ubcc.cabal index ee308a7..59c091a 100644 --- a/ubcc.cabal +++ b/ubcc.cabal @@ -31,7 +31,6 @@ library Ubc.Parse.Syntax.Expression Ubc.Parse.Syntax.File Ubc.Parse.Syntax.Function - Ubc.Parse.Syntax.Generic Ubc.Parse.Syntax.Import Ubc.Parse.Syntax.Language Ubc.Parse.Syntax.Operators @@ -56,7 +55,6 @@ library , os-string , parsec , path - , text , transformers default-language: Haskell2010 @@ -79,7 +77,6 @@ executable ubcc-exe , os-string , parsec , path - , text , transformers , ubcc default-language: Haskell2010 @@ -104,7 +101,6 @@ test-suite ubcc-test , os-string , parsec , path - , text , transformers , ubcc default-language: Haskell2010