diff --git a/src/Juvix/Compiler/Core/Language/Nodes.hs b/src/Juvix/Compiler/Core/Language/Nodes.hs index 127216fd87..1a3607a004 100644 --- a/src/Juvix/Compiler/Core/Language/Nodes.hs +++ b/src/Juvix/Compiler/Core/Language/Nodes.hs @@ -205,7 +205,9 @@ instance HasAtomicity (PatternBinder' i) where atomicity _ = Atom instance HasAtomicity (PatternConstr' i) where - atomicity _ = Aggregate appFixity + atomicity PatternConstr {..} + | null _patternConstrArgs = Atom + | otherwise = Aggregate appFixity instance HasAtomicity (Pattern' i) where atomicity = \case diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs index dc8d1bb898..0416297d36 100644 --- a/src/Juvix/Compiler/Core/Pretty/Base.hs +++ b/src/Juvix/Compiler/Core/Pretty/Base.hs @@ -171,7 +171,7 @@ instance PrettyCode PatternConstr where ppCode PatternConstr {..} = do n <- maybe (ppCode _patternConstrTag) ppCode (getInfoName _patternConstrInfo) args <- mapM (ppRightExpression appFixity) _patternConstrArgs - return $ n <+> hsep args + return $ foldl' (<+>) n args instance PrettyCode Pattern where ppCode = \case diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs index c3a4f6ad12..e9b04d3088 100644 --- a/src/Juvix/Compiler/Core/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs @@ -544,7 +544,7 @@ exprLambda :: HashMap Text Index -> ParsecS r Node exprLambda varsNum vars = do - kwLambda + lambda name <- parseLocalName let vars' = HashMap.insert (name ^. nameText) varsNum vars body <- expr (varsNum + 1) vars' @@ -796,12 +796,16 @@ binderOrConstrPattern :: Bool -> ParsecS r Pattern binderOrConstrPattern parseArgs = do + off <- P.getOffset (txt, i) <- identifierL r <- lift (getIdent txt) case r of Just (IdentTag tag) -> do ps <- if parseArgs then P.many branchPattern else return [] ci <- lift $ getConstructorInfo tag + when + (ci ^. constructorArgsNum /= length ps) + (parseFailure off "wrong number of constructor arguments") let info = setInfoName (ci ^. constructorName) Info.empty return $ PatConstr (PatternConstr info tag ps) _ -> do @@ -814,7 +818,7 @@ binderPattern :: Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => ParsecS r Pattern binderPattern = do - kwAt + symbolAt wildcardPattern <|> binderOrConstrPattern False <|> parens branchPattern diff --git a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs index 380069f9a6..868d603219 100644 --- a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs +++ b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs @@ -37,9 +37,6 @@ string = lexemeInterval string' keyword :: Text -> ParsecS r () keyword = keyword' space -rawKeyword :: Text -> ParsecS r () -rawKeyword = rawKeyword' space - identifier :: ParsecS r Text identifier = lexeme bareIdentifier @@ -53,9 +50,6 @@ bareIdentifier = rawIdentifier allKeywords allKeywords :: [ParsecS r ()] allKeywords = [ kwAssignment, - kwColon, - kwAt, - kwLambda, kwLet, kwLetRec, kwIn, @@ -89,6 +83,12 @@ allKeywords = kwFail ] +symbolAt :: ParsecS r () +symbolAt = symbol Str.at_ + +lambda :: ParsecS r () +lambda = symbol Str.lambdaUnicode <|> symbol Str.lambdaAscii + lbrace :: ParsecS r () lbrace = symbol "{" @@ -110,15 +110,6 @@ braces = between (symbol "{") (symbol "}") kwAssignment :: ParsecS r () kwAssignment = keyword Str.assignUnicode <|> keyword Str.assignAscii -kwColon :: ParsecS r () -kwColon = keyword Str.colon - -kwInductive :: ParsecS r () -kwInductive = keyword Str.inductive - -kwLambda :: ParsecS r () -kwLambda = rawKeyword Str.lambdaUnicode <|> rawKeyword Str.lambdaAscii - kwLet :: ParsecS r () kwLet = keyword Str.let_ @@ -170,9 +161,6 @@ kwComma = keyword Str.comma kwWildcard :: ParsecS r () kwWildcard = keyword Str.underscore -kwAt :: ParsecS r () -kwAt = keyword Str.at_ - kwPlus :: ParsecS r () kwPlus = keyword Str.plus diff --git a/src/Juvix/Parser/Lexer.hs b/src/Juvix/Parser/Lexer.hs index 09d910dd02..abf4fd0ac7 100644 --- a/src/Juvix/Parser/Lexer.hs +++ b/src/Juvix/Parser/Lexer.hs @@ -79,12 +79,6 @@ keywordL' spc kw = do spc return i -rawKeyword' :: ParsecS r () -> Text -> ParsecS r () -rawKeyword' spc kw = do - P.try $ do - void (P.chunk kw) - spc - rawIdentifier :: [ParsecS r ()] -> ParsecS r Text rawIdentifier allKeywords = do notFollowedBy (choice allKeywords)