From ef11da7458ac144cabe9e02cd552db4bf285f7f2 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Fri, 29 Nov 2024 16:36:57 +0100 Subject: [PATCH 1/9] rename signName --- .../Backend/Html/Translation/FromTyped.hs | 4 +-- .../Concrete/Data/InfoTableBuilder.hs | 2 +- src/Juvix/Compiler/Concrete/Extra.hs | 2 +- src/Juvix/Compiler/Concrete/Gen.hs | 4 +-- src/Juvix/Compiler/Concrete/Language.hs | 2 +- src/Juvix/Compiler/Concrete/Language/Base.hs | 31 +++++++++++++------ .../FromParsed/Analysis/Scoping.hs | 14 ++++----- .../Concrete/Translation/FromSource.hs | 2 +- .../Internal/Translation/FromConcrete.hs | 10 +++--- src/Juvix/Compiler/Pipeline/Package/Loader.hs | 2 +- 10 files changed, 42 insertions(+), 31 deletions(-) diff --git a/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs b/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs index eec28fb658..8a15928530 100644 --- a/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs +++ b/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs @@ -541,12 +541,12 @@ goAxiom axiom = do goDeriving :: forall r. (Members '[Reader HtmlOptions] r) => Deriving 'Scoped -> Sem r Html goDeriving def = do sig <- ppHelper (ppCode def) - defHeader (def ^. derivingFunLhs . funLhsName . functionDefName) sig Nothing + defHeader (def ^. derivingFunLhs . funLhsName . functionDefNameScoped) sig Nothing goFunctionDef :: forall r. (Members '[Reader HtmlOptions] r) => FunctionDef 'Scoped -> Sem r Html goFunctionDef def = do sig <- ppHelper (ppCode (functionDefLhs def)) - defHeader (def ^. signName . functionDefName) sig (def ^. signDoc) + defHeader (def ^. functionDefName . functionDefNameScoped) sig (def ^. signDoc) goInductive :: forall r. (Members '[Reader HtmlOptions] r) => InductiveDef 'Scoped -> Sem r Html goInductive def = do diff --git a/src/Juvix/Compiler/Concrete/Data/InfoTableBuilder.hs b/src/Juvix/Compiler/Concrete/Data/InfoTableBuilder.hs index 72a252a951..a2f304e66d 100644 --- a/src/Juvix/Compiler/Concrete/Data/InfoTableBuilder.hs +++ b/src/Juvix/Compiler/Concrete/Data/InfoTableBuilder.hs @@ -62,7 +62,7 @@ runInfoTableBuilder ini = reinterpret (runState ini) $ \case highlightDoc (ity ^. inductiveName . nameId) j RegisterFunctionDef f -> do let j = f ^. signDoc - fid = f ^. signName . functionDefName . nameId + fid = f ^. functionDefName . functionDefNameScoped . nameId modify' (over infoFunctions (HashMap.insert fid f)) highlightDoc fid j RegisterName n -> highlightName (S.anameFromName n) diff --git a/src/Juvix/Compiler/Concrete/Extra.hs b/src/Juvix/Compiler/Concrete/Extra.hs index 1484e573f2..2b0aae4fa7 100644 --- a/src/Juvix/Compiler/Concrete/Extra.hs +++ b/src/Juvix/Compiler/Concrete/Extra.hs @@ -72,7 +72,7 @@ groupStatements = \case definesSymbol n s = case s of StatementInductive d -> n `elem` syms d StatementAxiom d -> n == symbolParsed (d ^. axiomName) - StatementFunctionDef d -> withFunctionSymbol False (\n' -> n == symbolParsed n') (d ^. signName) + StatementFunctionDef d -> withFunctionSymbol False (\n' -> n == symbolParsed n') (d ^. functionDefName) _ -> False where syms :: InductiveDef s -> [Symbol] diff --git a/src/Juvix/Compiler/Concrete/Gen.hs b/src/Juvix/Compiler/Concrete/Gen.hs index 957a41d199..46ec5527c7 100644 --- a/src/Juvix/Compiler/Concrete/Gen.hs +++ b/src/Juvix/Compiler/Concrete/Gen.hs @@ -27,7 +27,7 @@ simplestFunctionDefParsed funNameTxt funBody = do simplestFunctionDef :: forall s. (SingI s) => FunctionName s -> ExpressionType s -> FunctionDef s simplestFunctionDef funName funBody = FunctionDef - { _signName = name, + { _functionDefName = name, _signBody = SigBodyExpression funBody, _signTypeSig = TypeSig @@ -48,7 +48,7 @@ simplestFunctionDef funName funBody = SParsed -> FunctionDefName funName SScoped -> FunctionDefNameScoped - { _functionDefName = funName, + { _functionDefNameScoped = funName, _functionDefNamePattern = Nothing } diff --git a/src/Juvix/Compiler/Concrete/Language.hs b/src/Juvix/Compiler/Concrete/Language.hs index 47b7af06c6..4ab99d87fd 100644 --- a/src/Juvix/Compiler/Concrete/Language.hs +++ b/src/Juvix/Compiler/Concrete/Language.hs @@ -30,7 +30,7 @@ statementLabel = \case StatementSyntax s -> goSyntax s StatementOpenModule {} -> Nothing StatementProjectionDef {} -> Nothing - StatementFunctionDef f -> withFunctionSymbol Nothing (Just . (^. symbolTypeLabel)) (f ^. signName) + StatementFunctionDef f -> withFunctionSymbol Nothing (Just . (^. symbolTypeLabel)) (f ^. functionDefName) StatementDeriving f -> withFunctionSymbol Nothing (Just . (^. symbolTypeLabel)) (f ^. derivingFunLhs . funLhsName) StatementImport i -> Just (i ^. importModulePath . to modulePathTypeLabel) StatementInductive i -> Just (i ^. inductiveName . symbolTypeLabel) diff --git a/src/Juvix/Compiler/Concrete/Language/Base.hs b/src/Juvix/Compiler/Concrete/Language/Base.hs index cdbb055fd1..fcad68838d 100644 --- a/src/Juvix/Compiler/Concrete/Language/Base.hs +++ b/src/Juvix/Compiler/Concrete/Language/Base.hs @@ -716,7 +716,7 @@ instance Serialize FunctionDefNameParsed instance NFData FunctionDefNameParsed data FunctionDefNameScoped = FunctionDefNameScoped - { _functionDefName :: S.Symbol, + { _functionDefNameScoped :: S.Symbol, _functionDefNamePattern :: Maybe PatternArg } deriving stock (Eq, Ord, Show, Generic) @@ -725,8 +725,19 @@ instance Serialize FunctionDefNameScoped instance NFData FunctionDefNameScoped +-- functionDefLhs :: FunctionDef s -> FunctionLhs s +-- functionDefLhs FunctionDef {..} = +-- FunctionLhs +-- { _funLhsBuiltin = _signBuiltin, +-- _funLhsTerminating = _signTerminating, +-- _funLhsInstance = _signInstance, +-- _funLhsCoercion = _signCoercion, +-- _funLhsName = _signName, +-- _funLhsTypeSig = _signTypeSig +-- } + data FunctionDef (s :: Stage) = FunctionDef - { _signName :: FunctionSymbolType s, + { _functionDefName :: FunctionSymbolType s, _signTypeSig :: TypeSig s, _signDoc :: Maybe (Judoc s), _signPragmas :: Maybe ParsedPragmas, @@ -3064,7 +3075,7 @@ functionDefLhs FunctionDef {..} = _funLhsTerminating = _signTerminating, _funLhsInstance = _signInstance, _funLhsCoercion = _signCoercion, - _funLhsName = _signName, + _funLhsName = _functionDefName, _funLhsTypeSig = _signTypeSig } @@ -3263,7 +3274,7 @@ getLocFunctionSymbolType = case sing :: SStage s of instance HasLoc FunctionDefNameScoped where getLoc FunctionDefNameScoped {..} = - getLoc _functionDefName + getLoc _functionDefNameScoped <>? (getLoc <$> _functionDefNamePattern) instance HasLoc FunctionDefNameParsed where @@ -3529,7 +3540,7 @@ instance (SingI s) => HasLoc (FunctionDef s) where ?<> (getLoc <$> _signPragmas) ?<> (getLoc <$> _signBuiltin) ?<> (getLoc <$> _signTerminating) - ?<> (getLocFunctionSymbolType _signName) + ?<> (getLocFunctionSymbolType _functionDefName) <> getLoc _signBody instance HasLoc (Example s) where @@ -3719,7 +3730,7 @@ getFunctionSymbol sym = case sing :: SStage s of SParsed -> case sym of FunctionDefName p -> p FunctionDefNamePattern {} -> impossibleError "invalid call" - SScoped -> sym ^. functionDefName + SScoped -> sym ^. functionDefNameScoped functionSymbolPattern :: forall s. (SingI s) => FunctionSymbolType s -> Maybe (PatternAtomType s) functionSymbolPattern f = case sing :: SStage s of @@ -3729,19 +3740,19 @@ functionSymbolPattern f = case sing :: SStage s of withFunctionSymbol :: forall s a. (SingI s) => a -> (SymbolType s -> a) -> FunctionSymbolType s -> a withFunctionSymbol a f sym = case sing :: SStage s of SParsed -> maybe a f (sym ^? _FunctionDefName) - SScoped -> f (sym ^. functionDefName) + SScoped -> f (sym ^. functionDefNameScoped) namedArgumentNewSymbolParsed :: (SingI s) => SimpleGetter (NamedArgumentNew s) Symbol namedArgumentNewSymbolParsed = to $ \case NamedArgumentItemPun a -> a ^. namedArgumentPunSymbol - NamedArgumentNewFunction a -> symbolParsed (getFunctionSymbol (a ^. namedArgumentFunctionDef . signName)) + NamedArgumentNewFunction a -> symbolParsed (getFunctionSymbol (a ^. namedArgumentFunctionDef . functionDefName)) namedArgumentNewSymbol :: Lens' (NamedArgumentNew 'Parsed) Symbol namedArgumentNewSymbol f = \case NamedArgumentItemPun a -> NamedArgumentItemPun <$> (namedArgumentPunSymbol f a) NamedArgumentNewFunction a -> do - a' <- f (a ^?! namedArgumentFunctionDef . signName . _FunctionDefName) - return $ NamedArgumentNewFunction (over namedArgumentFunctionDef (set signName (FunctionDefName a')) a) + a' <- f (a ^?! namedArgumentFunctionDef . functionDefName . _FunctionDefName) + return $ NamedArgumentNewFunction (over namedArgumentFunctionDef (set functionDefName (FunctionDefName a')) a) scopedIdenSrcName :: Lens' ScopedIden S.Name scopedIdenSrcName f n = case n ^. scopedIdenAlias of diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs index c26b0fdf05..c125747a36 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs @@ -1129,7 +1129,7 @@ checkDeriving Deriving {..} = do | otherwise -> reserveFunctionSymbol lhs let defname' = FunctionDefNameScoped - { _functionDefName = name', + { _functionDefNameScoped = name', _functionDefNamePattern = Nothing } let lhs' = @@ -1197,8 +1197,8 @@ checkFunctionDef fdef@FunctionDef {..} = do a' <- checkTypeSig _signTypeSig b' <- checkBody return (a', b') - whenJust (functionSymbolPattern _signName) reservePatternFunctionSymbols - sigName' <- case _signName of + whenJust (functionSymbolPattern _functionDefName) reservePatternFunctionSymbols + sigName' <- case _functionDefName of FunctionDefName name -> do name' <- if @@ -1206,7 +1206,7 @@ checkFunctionDef fdef@FunctionDef {..} = do | otherwise -> reserveFunctionSymbol (functionDefLhs fdef) return FunctionDefNameScoped - { _functionDefName = name', + { _functionDefNameScoped = name', _functionDefNamePattern = Nothing } FunctionDefNamePattern p -> do @@ -1214,18 +1214,18 @@ checkFunctionDef fdef@FunctionDef {..} = do p' <- runReader PatternNamesKindFunctions (checkParsePatternAtom p) return FunctionDefNameScoped - { _functionDefName = name', + { _functionDefNameScoped = name', _functionDefNamePattern = Just p' } let def = FunctionDef - { _signName = sigName', + { _functionDefName = sigName', _signDoc = sigDoc', _signBody = sigBody', _signTypeSig = sig', .. } - registerNameSignature (sigName' ^. functionDefName . S.nameId) def + registerNameSignature (sigName' ^. functionDefNameScoped . S.nameId) def registerFunctionDef @$> def where checkBody :: Sem r (FunctionDefBody 'Scoped) diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs index 24b48a0afe..9a330671f9 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs @@ -1445,7 +1445,7 @@ functionDefinition opts _signBuiltin = P.label "" $ do $ parseFailure off "expected result type" let fdef = FunctionDef - { _signName = _funLhsName, + { _functionDefName = _funLhsName, _signTypeSig = _funLhsTypeSig, _signTerminating = _funLhsTerminating, _signInstance = _funLhsInstance, diff --git a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs index db7e20af5e..d02c764c23 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs +++ b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs @@ -433,7 +433,7 @@ goDeriving :: Sem r Internal.FunctionDef goDeriving Deriving {..} = do let FunctionLhs {..} = _derivingFunLhs - name = goSymbol (_funLhsName ^. functionDefName) + name = goSymbol (_funLhsName ^. functionDefNameScoped) (funArgs, ret) <- Internal.unfoldFunType <$> goDefType _derivingFunLhs let (mtrait, traitArgs) = Internal.unfoldExpressionApp ret (n, der) <- findDerivingTrait mtrait @@ -893,7 +893,7 @@ goFunctionDef :: FunctionDef 'Scoped -> Sem r [Internal.FunctionDef] goFunctionDef def@FunctionDef {..} = do - let _funDefName = goSymbol (_signName ^. functionDefName) + let _funDefName = goSymbol (_functionDefName ^. functionDefNameScoped) _funDefTerminating = isJust _signTerminating _funDefIsInstanceCoercion | isJust _signCoercion = Just Internal.IsInstanceCoercionCoercion @@ -908,7 +908,7 @@ goFunctionDef def@FunctionDef {..} = do let _funDefDocComment = fmap ppPrintJudoc _signDoc fun = Internal.FunctionDef {..} whenJust _signBuiltin (checkBuiltinFunction fun . (^. withLocParam)) - case _signName ^. functionDefNamePattern of + case _functionDefName ^. functionDefNamePattern of Just pat -> do pat' <- goPatternArg pat (fun :) <$> Internal.genPatternDefs _funDefName pat' @@ -1319,7 +1319,7 @@ createArgumentBlocks appargs = where namedArgumentRefSymbol :: NamedArgumentNew 'Scoped -> S.Symbol namedArgumentRefSymbol = \case - NamedArgumentNewFunction p -> p ^. namedArgumentFunctionDef . signName . functionDefName + NamedArgumentNewFunction p -> p ^. namedArgumentFunctionDef . functionDefName . functionDefNameScoped NamedArgumentItemPun p -> over S.nameConcrete fromUnqualified' (p ^. namedArgumentReferencedSymbol . scopedIdenFinal) args0 :: HashSet S.Symbol = hashSet (namedArgumentRefSymbol <$> appargs) goBlock :: @@ -1416,8 +1416,8 @@ goExpression = \case funs ^.. each . namedArgumentFunctionDef - . signName . functionDefName + . functionDefNameScoped . to goSymbol -- changes the kind from Variable to Function updateKind :: Internal.Subs = Internal.subsKind funsNames KNameFunction diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader.hs b/src/Juvix/Compiler/Pipeline/Package/Loader.hs index 7c24a72d36..96584b7d05 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader.hs @@ -99,7 +99,7 @@ toConcrete t p = run . runReader l $ do _signDoc = Nothing, _signCoercion = Nothing, _signBuiltin = Nothing, - _signName = FunctionDefName name', + _functionDefName = FunctionDefName name', _signBody, _signTypeSig } From 8f956d51de7655d8fe3edd4413e71371f6530b73 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Fri, 29 Nov 2024 16:38:37 +0100 Subject: [PATCH 2/9] rename signTypeSig --- src/Juvix/Compiler/Concrete/Gen.hs | 2 +- src/Juvix/Compiler/Concrete/Language/Base.hs | 6 +++--- .../Concrete/Translation/FromParsed/Analysis/Scoping.hs | 4 ++-- src/Juvix/Compiler/Concrete/Translation/FromSource.hs | 2 +- src/Juvix/Compiler/Internal/Translation/FromConcrete.hs | 2 +- src/Juvix/Compiler/Pipeline/Package/Loader.hs | 4 ++-- 6 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Juvix/Compiler/Concrete/Gen.hs b/src/Juvix/Compiler/Concrete/Gen.hs index 46ec5527c7..c57a357da0 100644 --- a/src/Juvix/Compiler/Concrete/Gen.hs +++ b/src/Juvix/Compiler/Concrete/Gen.hs @@ -29,7 +29,7 @@ simplestFunctionDef funName funBody = FunctionDef { _functionDefName = name, _signBody = SigBodyExpression funBody, - _signTypeSig = + _functionDefTypesig = TypeSig { _typeSigColonKw = Irrelevant Nothing, _typeSigArgs = [], diff --git a/src/Juvix/Compiler/Concrete/Language/Base.hs b/src/Juvix/Compiler/Concrete/Language/Base.hs index fcad68838d..365347add7 100644 --- a/src/Juvix/Compiler/Concrete/Language/Base.hs +++ b/src/Juvix/Compiler/Concrete/Language/Base.hs @@ -733,12 +733,12 @@ instance NFData FunctionDefNameScoped -- _funLhsInstance = _signInstance, -- _funLhsCoercion = _signCoercion, -- _funLhsName = _signName, --- _funLhsTypeSig = _signTypeSig +-- _funLhsTypeSig = _functionDefTypesig -- } data FunctionDef (s :: Stage) = FunctionDef { _functionDefName :: FunctionSymbolType s, - _signTypeSig :: TypeSig s, + _functionDefTypesig :: TypeSig s, _signDoc :: Maybe (Judoc s), _signPragmas :: Maybe ParsedPragmas, _signBuiltin :: Maybe (WithLoc BuiltinFunction), @@ -3076,7 +3076,7 @@ functionDefLhs FunctionDef {..} = _funLhsInstance = _signInstance, _funLhsCoercion = _signCoercion, _funLhsName = _functionDefName, - _funLhsTypeSig = _signTypeSig + _funLhsTypeSig = _functionDefTypesig } fixityFieldHelper :: SimpleGetter (ParsedFixityFields s) (Maybe a) -> SimpleGetter (ParsedFixityInfo s) (Maybe a) diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs index c125747a36..105d8fc2b4 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs @@ -1194,7 +1194,7 @@ checkFunctionDef :: checkFunctionDef fdef@FunctionDef {..} = do sigDoc' <- mapM checkJudoc _signDoc (sig', sigBody') <- withLocalScope $ do - a' <- checkTypeSig _signTypeSig + a' <- checkTypeSig _functionDefTypesig b' <- checkBody return (a', b') whenJust (functionSymbolPattern _functionDefName) reservePatternFunctionSymbols @@ -1222,7 +1222,7 @@ checkFunctionDef fdef@FunctionDef {..} = do { _functionDefName = sigName', _signDoc = sigDoc', _signBody = sigBody', - _signTypeSig = sig', + _functionDefTypesig = sig', .. } registerNameSignature (sigName' ^. functionDefNameScoped . S.nameId) def diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs index 9a330671f9..d0928aaa3f 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs @@ -1446,7 +1446,7 @@ functionDefinition opts _signBuiltin = P.label "" $ do let fdef = FunctionDef { _functionDefName = _funLhsName, - _signTypeSig = _funLhsTypeSig, + _functionDefTypesig = _funLhsTypeSig, _signTerminating = _funLhsTerminating, _signInstance = _funLhsInstance, _signCoercion = _funLhsCoercion, diff --git a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs index d02c764c23..3f5505a2b2 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs +++ b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs @@ -917,7 +917,7 @@ goFunctionDef def@FunctionDef {..} = do where goBody :: Sem r Internal.Expression goBody = do - commonPatterns <- concatMapM (fmap toList . argToPattern) (_signTypeSig ^. typeSigArgs) + commonPatterns <- concatMapM (fmap toList . argToPattern) (_functionDefTypesig ^. typeSigArgs) let goClause :: FunctionClause 'Scoped -> Sem r Internal.LambdaClause goClause FunctionClause {..} = do _lambdaBody <- goExpression _clausenBody diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader.hs b/src/Juvix/Compiler/Pipeline/Package/Loader.hs index 96584b7d05..215f1aa1c2 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader.hs @@ -84,7 +84,7 @@ toConcrete t p = run . runReader l $ do name' <- symbol Str.package _typeSigColonKw <- Irrelevant . Just <$> kw kwColon let _signBody = (t ^. packageDescriptionTypeTransform) p - _signTypeSig = + _functionDefTypesig = TypeSig { _typeSigArgs = [], _typeSigRetType, @@ -101,7 +101,7 @@ toConcrete t p = run . runReader l $ do _signBuiltin = Nothing, _functionDefName = FunctionDefName name', _signBody, - _signTypeSig + _functionDefTypesig } ) From 7ccebc4d5ad4b7de17bd3ca2470f5b31c995e546 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Fri, 29 Nov 2024 16:46:15 +0100 Subject: [PATCH 3/9] doc and pragmas --- app/Commands/Repl.hs | 2 +- src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs | 2 +- src/Juvix/Compiler/Concrete/Data/InfoTableBuilder.hs | 2 +- src/Juvix/Compiler/Concrete/Gen.hs | 4 ++-- src/Juvix/Compiler/Concrete/Language/Base.hs | 8 ++++---- src/Juvix/Compiler/Concrete/Print/Base.hs | 4 ++-- .../Concrete/Translation/FromParsed/Analysis/Scoping.hs | 4 ++-- src/Juvix/Compiler/Concrete/Translation/FromSource.hs | 8 ++++---- src/Juvix/Compiler/Internal/Translation/FromConcrete.hs | 4 ++-- src/Juvix/Compiler/Pipeline/Package/Loader.hs | 4 ++-- 10 files changed, 21 insertions(+), 21 deletions(-) diff --git a/app/Commands/Repl.hs b/app/Commands/Repl.hs index c7a87ffa92..1e84f298c8 100644 --- a/app/Commands/Repl.hs +++ b/app/Commands/Repl.hs @@ -293,7 +293,7 @@ printDocumentation = replParseIdentifiers >=> printIdentifiers getDocFunction fun = do tbl :: Scoped.InfoTable <- getScopedInfoTable let def = tbl ^?! Scoped.infoFunctions . at fun . _Just - return (def ^. Concrete.signDoc) + return (def ^. Concrete.functionDefDoc) getDocInductive :: Scoped.NameId -> Repl (Maybe (Concrete.Judoc 'Concrete.Scoped)) getDocInductive ind = do diff --git a/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs b/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs index 8a15928530..920469c05e 100644 --- a/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs +++ b/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs @@ -546,7 +546,7 @@ goDeriving def = do goFunctionDef :: forall r. (Members '[Reader HtmlOptions] r) => FunctionDef 'Scoped -> Sem r Html goFunctionDef def = do sig <- ppHelper (ppCode (functionDefLhs def)) - defHeader (def ^. functionDefName . functionDefNameScoped) sig (def ^. signDoc) + defHeader (def ^. functionDefName . functionDefNameScoped) sig (def ^. functionDefDoc) goInductive :: forall r. (Members '[Reader HtmlOptions] r) => InductiveDef 'Scoped -> Sem r Html goInductive def = do diff --git a/src/Juvix/Compiler/Concrete/Data/InfoTableBuilder.hs b/src/Juvix/Compiler/Concrete/Data/InfoTableBuilder.hs index a2f304e66d..147a971e25 100644 --- a/src/Juvix/Compiler/Concrete/Data/InfoTableBuilder.hs +++ b/src/Juvix/Compiler/Concrete/Data/InfoTableBuilder.hs @@ -61,7 +61,7 @@ runInfoTableBuilder ini = reinterpret (runState ini) $ \case modify' (over infoInductives (HashMap.insert (ity ^. inductiveName . nameId) ity)) highlightDoc (ity ^. inductiveName . nameId) j RegisterFunctionDef f -> do - let j = f ^. signDoc + let j = f ^. functionDefDoc fid = f ^. functionDefName . functionDefNameScoped . nameId modify' (over infoFunctions (HashMap.insert fid f)) highlightDoc fid j diff --git a/src/Juvix/Compiler/Concrete/Gen.hs b/src/Juvix/Compiler/Concrete/Gen.hs index c57a357da0..b218083dc9 100644 --- a/src/Juvix/Compiler/Concrete/Gen.hs +++ b/src/Juvix/Compiler/Concrete/Gen.hs @@ -35,8 +35,8 @@ simplestFunctionDef funName funBody = _typeSigArgs = [], _typeSigRetType = Nothing }, - _signDoc = Nothing, - _signPragmas = Nothing, + _functionDefDoc = Nothing, + _functionDefPragmas = Nothing, _signBuiltin = Nothing, _signTerminating = Nothing, _signInstance = Nothing, diff --git a/src/Juvix/Compiler/Concrete/Language/Base.hs b/src/Juvix/Compiler/Concrete/Language/Base.hs index 365347add7..9fd9e3d79a 100644 --- a/src/Juvix/Compiler/Concrete/Language/Base.hs +++ b/src/Juvix/Compiler/Concrete/Language/Base.hs @@ -739,8 +739,8 @@ instance NFData FunctionDefNameScoped data FunctionDef (s :: Stage) = FunctionDef { _functionDefName :: FunctionSymbolType s, _functionDefTypesig :: TypeSig s, - _signDoc :: Maybe (Judoc s), - _signPragmas :: Maybe ParsedPragmas, + _functionDefDoc :: Maybe (Judoc s), + _functionDefPragmas :: Maybe ParsedPragmas, _signBuiltin :: Maybe (WithLoc BuiltinFunction), _signBody :: FunctionDefBody s, _signTerminating :: Maybe KeywordRef, @@ -3536,8 +3536,8 @@ instance (SingI s) => HasLoc (FunctionDefBody s) where instance (SingI s) => HasLoc (FunctionDef s) where getLoc FunctionDef {..} = - (getLoc <$> _signDoc) - ?<> (getLoc <$> _signPragmas) + (getLoc <$> _functionDefDoc) + ?<> (getLoc <$> _functionDefPragmas) ?<> (getLoc <$> _signBuiltin) ?<> (getLoc <$> _signTerminating) ?<> (getLocFunctionSymbolType _functionDefName) diff --git a/src/Juvix/Compiler/Concrete/Print/Base.hs b/src/Juvix/Compiler/Concrete/Print/Base.hs index d6368a2aee..022ef42ff0 100644 --- a/src/Juvix/Compiler/Concrete/Print/Base.hs +++ b/src/Juvix/Compiler/Concrete/Print/Base.hs @@ -1205,8 +1205,8 @@ ppPipeBranches allowSameLine isTop ppBranch = \case instance (SingI s) => PrettyPrint (FunctionDef s) where ppCode :: forall r. (Members '[ExactPrint, Reader Options] r) => FunctionDef s -> Sem r () ppCode fun@FunctionDef {..} = do - let doc' :: Maybe (Sem r ()) = ppCode <$> _signDoc - pragmas' :: Maybe (Sem r ()) = ppCode <$> _signPragmas + let doc' :: Maybe (Sem r ()) = ppCode <$> _functionDefDoc + pragmas' :: Maybe (Sem r ()) = ppCode <$> _functionDefPragmas sig' = ppCode (functionDefLhs fun) body' = case _signBody of SigBodyExpression e -> space <> ppCode Kw.kwAssign <> oneLineOrNext (ppTopExpressionType e) diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs index 105d8fc2b4..2cd9943204 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs @@ -1192,7 +1192,7 @@ checkFunctionDef :: FunctionDef 'Parsed -> Sem r (FunctionDef 'Scoped) checkFunctionDef fdef@FunctionDef {..} = do - sigDoc' <- mapM checkJudoc _signDoc + sigDoc' <- mapM checkJudoc _functionDefDoc (sig', sigBody') <- withLocalScope $ do a' <- checkTypeSig _functionDefTypesig b' <- checkBody @@ -1220,7 +1220,7 @@ checkFunctionDef fdef@FunctionDef {..} = do let def = FunctionDef { _functionDefName = sigName', - _signDoc = sigDoc', + _functionDefDoc = sigDoc', _signBody = sigBody', _functionDefTypesig = sig', .. diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs index d0928aaa3f..dd6bc7422c 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs @@ -1435,8 +1435,8 @@ functionDefinition opts _signBuiltin = P.label "" $ do off0 <- P.getOffset FunctionLhs {..} <- functionDefinitionLhs opts _signBuiltin off <- P.getOffset - _signDoc <- getJudoc - _signPragmas <- getPragmas + _functionDefDoc <- getJudoc + _functionDefPragmas <- getPragmas _signBody <- parseBody unless ( isJust (_funLhsTypeSig ^. typeSigColonKw . unIrrelevant) @@ -1451,8 +1451,8 @@ functionDefinition opts _signBuiltin = P.label "" $ do _signInstance = _funLhsInstance, _signCoercion = _funLhsCoercion, _signBuiltin = _funLhsBuiltin, - _signDoc, - _signPragmas, + _functionDefDoc, + _functionDefPragmas, _signBody } when (isNothing (_funLhsName ^? _FunctionDefName) && P.isFunctionLike fdef) $ diff --git a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs index 3f5505a2b2..e5423428ab 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs +++ b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs @@ -902,10 +902,10 @@ goFunctionDef def@FunctionDef {..} = do _funDefCoercion = isJust _signCoercion _funDefBuiltin = (^. withLocParam) <$> _signBuiltin _funDefType <- goDefType (functionDefLhs def) - _funDefPragmas <- goPragmas _signPragmas + _funDefPragmas <- goPragmas _functionDefPragmas _funDefBody <- goBody _funDefArgsInfo <- goArgsInfo _funDefName - let _funDefDocComment = fmap ppPrintJudoc _signDoc + let _funDefDocComment = fmap ppPrintJudoc _functionDefDoc fun = Internal.FunctionDef {..} whenJust _signBuiltin (checkBuiltinFunction fun . (^. withLocParam)) case _functionDefName ^. functionDefNamePattern of diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader.hs b/src/Juvix/Compiler/Pipeline/Package/Loader.hs index 215f1aa1c2..d6fecb0fd2 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader.hs @@ -94,9 +94,9 @@ toConcrete t p = run . runReader l $ do ( StatementFunctionDef FunctionDef { _signTerminating = Nothing, - _signPragmas = Nothing, + _functionDefPragmas = Nothing, _signInstance = Nothing, - _signDoc = Nothing, + _functionDefDoc = Nothing, _signCoercion = Nothing, _signBuiltin = Nothing, _functionDefName = FunctionDefName name', From e83a078412228083ef9bf75500304bda5df210c2 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Fri, 29 Nov 2024 16:47:07 +0100 Subject: [PATCH 4/9] functionDefBuiltin --- src/Juvix/Compiler/Concrete/Gen.hs | 2 +- src/Juvix/Compiler/Concrete/Language/Base.hs | 8 ++++---- src/Juvix/Compiler/Concrete/Translation/FromSource.hs | 6 +++--- src/Juvix/Compiler/Internal/Translation/FromConcrete.hs | 4 ++-- src/Juvix/Compiler/Pipeline/Package/Loader.hs | 2 +- 5 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/Juvix/Compiler/Concrete/Gen.hs b/src/Juvix/Compiler/Concrete/Gen.hs index b218083dc9..d1e3b1b93f 100644 --- a/src/Juvix/Compiler/Concrete/Gen.hs +++ b/src/Juvix/Compiler/Concrete/Gen.hs @@ -37,7 +37,7 @@ simplestFunctionDef funName funBody = }, _functionDefDoc = Nothing, _functionDefPragmas = Nothing, - _signBuiltin = Nothing, + _functionDefBuiltin = Nothing, _signTerminating = Nothing, _signInstance = Nothing, _signCoercion = Nothing diff --git a/src/Juvix/Compiler/Concrete/Language/Base.hs b/src/Juvix/Compiler/Concrete/Language/Base.hs index 9fd9e3d79a..a3cabe30f3 100644 --- a/src/Juvix/Compiler/Concrete/Language/Base.hs +++ b/src/Juvix/Compiler/Concrete/Language/Base.hs @@ -728,7 +728,7 @@ instance NFData FunctionDefNameScoped -- functionDefLhs :: FunctionDef s -> FunctionLhs s -- functionDefLhs FunctionDef {..} = -- FunctionLhs --- { _funLhsBuiltin = _signBuiltin, +-- { _funLhsBuiltin = _functionDefBuiltin, -- _funLhsTerminating = _signTerminating, -- _funLhsInstance = _signInstance, -- _funLhsCoercion = _signCoercion, @@ -741,7 +741,7 @@ data FunctionDef (s :: Stage) = FunctionDef _functionDefTypesig :: TypeSig s, _functionDefDoc :: Maybe (Judoc s), _functionDefPragmas :: Maybe ParsedPragmas, - _signBuiltin :: Maybe (WithLoc BuiltinFunction), + _functionDefBuiltin :: Maybe (WithLoc BuiltinFunction), _signBody :: FunctionDefBody s, _signTerminating :: Maybe KeywordRef, _signInstance :: Maybe KeywordRef, @@ -3071,7 +3071,7 @@ makePrisms ''FunctionDefNameParsed functionDefLhs :: FunctionDef s -> FunctionLhs s functionDefLhs FunctionDef {..} = FunctionLhs - { _funLhsBuiltin = _signBuiltin, + { _funLhsBuiltin = _functionDefBuiltin, _funLhsTerminating = _signTerminating, _funLhsInstance = _signInstance, _funLhsCoercion = _signCoercion, @@ -3538,7 +3538,7 @@ instance (SingI s) => HasLoc (FunctionDef s) where getLoc FunctionDef {..} = (getLoc <$> _functionDefDoc) ?<> (getLoc <$> _functionDefPragmas) - ?<> (getLoc <$> _signBuiltin) + ?<> (getLoc <$> _functionDefBuiltin) ?<> (getLoc <$> _signTerminating) ?<> (getLocFunctionSymbolType _functionDefName) <> getLoc _signBody diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs index dd6bc7422c..96127f0471 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs @@ -1431,9 +1431,9 @@ functionDefinition :: FunctionSyntaxOptions -> Maybe (WithLoc BuiltinFunction) -> ParsecS r (FunctionDef 'Parsed) -functionDefinition opts _signBuiltin = P.label "" $ do +functionDefinition opts _functionDefBuiltin = P.label "" $ do off0 <- P.getOffset - FunctionLhs {..} <- functionDefinitionLhs opts _signBuiltin + FunctionLhs {..} <- functionDefinitionLhs opts _functionDefBuiltin off <- P.getOffset _functionDefDoc <- getJudoc _functionDefPragmas <- getPragmas @@ -1450,7 +1450,7 @@ functionDefinition opts _signBuiltin = P.label "" $ do _signTerminating = _funLhsTerminating, _signInstance = _funLhsInstance, _signCoercion = _funLhsCoercion, - _signBuiltin = _funLhsBuiltin, + _functionDefBuiltin = _funLhsBuiltin, _functionDefDoc, _functionDefPragmas, _signBody diff --git a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs index e5423428ab..07769db610 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs +++ b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs @@ -900,14 +900,14 @@ goFunctionDef def@FunctionDef {..} = do | isJust _signInstance = Just Internal.IsInstanceCoercionInstance | otherwise = Nothing _funDefCoercion = isJust _signCoercion - _funDefBuiltin = (^. withLocParam) <$> _signBuiltin + _funDefBuiltin = (^. withLocParam) <$> _functionDefBuiltin _funDefType <- goDefType (functionDefLhs def) _funDefPragmas <- goPragmas _functionDefPragmas _funDefBody <- goBody _funDefArgsInfo <- goArgsInfo _funDefName let _funDefDocComment = fmap ppPrintJudoc _functionDefDoc fun = Internal.FunctionDef {..} - whenJust _signBuiltin (checkBuiltinFunction fun . (^. withLocParam)) + whenJust _functionDefBuiltin (checkBuiltinFunction fun . (^. withLocParam)) case _functionDefName ^. functionDefNamePattern of Just pat -> do pat' <- goPatternArg pat diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader.hs b/src/Juvix/Compiler/Pipeline/Package/Loader.hs index d6fecb0fd2..143efb2639 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader.hs @@ -98,7 +98,7 @@ toConcrete t p = run . runReader l $ do _signInstance = Nothing, _functionDefDoc = Nothing, _signCoercion = Nothing, - _signBuiltin = Nothing, + _functionDefBuiltin = Nothing, _functionDefName = FunctionDefName name', _signBody, _functionDefTypesig From d088ca3c8c06864de6e41a9ce9edd9d923167cc5 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Fri, 29 Nov 2024 16:47:31 +0100 Subject: [PATCH 5/9] functionDefBody --- src/Juvix/Compiler/Concrete/Extra.hs | 2 +- src/Juvix/Compiler/Concrete/Gen.hs | 2 +- src/Juvix/Compiler/Concrete/Language/Base.hs | 4 ++-- src/Juvix/Compiler/Concrete/Print/Base.hs | 2 +- .../Concrete/Translation/FromParsed/Analysis/Scoping.hs | 4 ++-- src/Juvix/Compiler/Concrete/Translation/FromSource.hs | 6 +++--- src/Juvix/Compiler/Internal/Translation/FromConcrete.hs | 2 +- src/Juvix/Compiler/Pipeline/Package/Loader.hs | 4 ++-- 8 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/Juvix/Compiler/Concrete/Extra.hs b/src/Juvix/Compiler/Concrete/Extra.hs index 2b0aae4fa7..61bbdd0072 100644 --- a/src/Juvix/Compiler/Concrete/Extra.hs +++ b/src/Juvix/Compiler/Concrete/Extra.hs @@ -115,4 +115,4 @@ isLhsFunctionLike FunctionLhs {..} = notNull (_funLhsTypeSig ^. typeSigArgs) isFunctionLike :: FunctionDef 'Parsed -> Bool isFunctionLike d@FunctionDef {..} = - isLhsFunctionLike (functionDefLhs d) || (not . isBodyExpression) _signBody + isLhsFunctionLike (functionDefLhs d) || (not . isBodyExpression) _functionDefBody diff --git a/src/Juvix/Compiler/Concrete/Gen.hs b/src/Juvix/Compiler/Concrete/Gen.hs index d1e3b1b93f..238d681f5c 100644 --- a/src/Juvix/Compiler/Concrete/Gen.hs +++ b/src/Juvix/Compiler/Concrete/Gen.hs @@ -28,7 +28,7 @@ simplestFunctionDef :: forall s. (SingI s) => FunctionName s -> ExpressionType s simplestFunctionDef funName funBody = FunctionDef { _functionDefName = name, - _signBody = SigBodyExpression funBody, + _functionDefBody = SigBodyExpression funBody, _functionDefTypesig = TypeSig { _typeSigColonKw = Irrelevant Nothing, diff --git a/src/Juvix/Compiler/Concrete/Language/Base.hs b/src/Juvix/Compiler/Concrete/Language/Base.hs index a3cabe30f3..9b0f79a7da 100644 --- a/src/Juvix/Compiler/Concrete/Language/Base.hs +++ b/src/Juvix/Compiler/Concrete/Language/Base.hs @@ -742,7 +742,7 @@ data FunctionDef (s :: Stage) = FunctionDef _functionDefDoc :: Maybe (Judoc s), _functionDefPragmas :: Maybe ParsedPragmas, _functionDefBuiltin :: Maybe (WithLoc BuiltinFunction), - _signBody :: FunctionDefBody s, + _functionDefBody :: FunctionDefBody s, _signTerminating :: Maybe KeywordRef, _signInstance :: Maybe KeywordRef, _signCoercion :: Maybe KeywordRef @@ -3541,7 +3541,7 @@ instance (SingI s) => HasLoc (FunctionDef s) where ?<> (getLoc <$> _functionDefBuiltin) ?<> (getLoc <$> _signTerminating) ?<> (getLocFunctionSymbolType _functionDefName) - <> getLoc _signBody + <> getLoc _functionDefBody instance HasLoc (Example s) where getLoc e = e ^. exampleLoc diff --git a/src/Juvix/Compiler/Concrete/Print/Base.hs b/src/Juvix/Compiler/Concrete/Print/Base.hs index 022ef42ff0..50148e9674 100644 --- a/src/Juvix/Compiler/Concrete/Print/Base.hs +++ b/src/Juvix/Compiler/Concrete/Print/Base.hs @@ -1208,7 +1208,7 @@ instance (SingI s) => PrettyPrint (FunctionDef s) where let doc' :: Maybe (Sem r ()) = ppCode <$> _functionDefDoc pragmas' :: Maybe (Sem r ()) = ppCode <$> _functionDefPragmas sig' = ppCode (functionDefLhs fun) - body' = case _signBody of + body' = case _functionDefBody of SigBodyExpression e -> space <> ppCode Kw.kwAssign <> oneLineOrNext (ppTopExpressionType e) SigBodyClauses k -> ppPipeBranches False Top ppFunctionClause k doc' diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs index 2cd9943204..3bbd409adc 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs @@ -1221,7 +1221,7 @@ checkFunctionDef fdef@FunctionDef {..} = do FunctionDef { _functionDefName = sigName', _functionDefDoc = sigDoc', - _signBody = sigBody', + _functionDefBody = sigBody', _functionDefTypesig = sig', .. } @@ -1229,7 +1229,7 @@ checkFunctionDef fdef@FunctionDef {..} = do registerFunctionDef @$> def where checkBody :: Sem r (FunctionDefBody 'Scoped) - checkBody = case _signBody of + checkBody = case _functionDefBody of SigBodyExpression e -> SigBodyExpression <$> checkParseExpressionAtoms e SigBodyClauses cls -> SigBodyClauses <$> mapM checkClause cls diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs index 96127f0471..908062421b 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs @@ -1437,10 +1437,10 @@ functionDefinition opts _functionDefBuiltin = P.label "" $ off <- P.getOffset _functionDefDoc <- getJudoc _functionDefPragmas <- getPragmas - _signBody <- parseBody + _functionDefBody <- parseBody unless ( isJust (_funLhsTypeSig ^. typeSigColonKw . unIrrelevant) - || (P.isBodyExpression _signBody && null (_funLhsTypeSig ^. typeSigArgs)) + || (P.isBodyExpression _functionDefBody && null (_funLhsTypeSig ^. typeSigArgs)) ) $ parseFailure off "expected result type" let fdef = @@ -1453,7 +1453,7 @@ functionDefinition opts _functionDefBuiltin = P.label "" $ _functionDefBuiltin = _funLhsBuiltin, _functionDefDoc, _functionDefPragmas, - _signBody + _functionDefBody } when (isNothing (_funLhsName ^? _FunctionDefName) && P.isFunctionLike fdef) $ parseFailure off0 "expected function name" diff --git a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs index 07769db610..4c39038ab7 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs +++ b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs @@ -924,7 +924,7 @@ goFunctionDef def@FunctionDef {..} = do extraPatterns <- mapM goPatternArg _clausenPatterns let _lambdaPatterns = prependList commonPatterns extraPatterns return Internal.LambdaClause {..} - case _signBody of + case _functionDefBody of SigBodyExpression body -> do body' <- goExpression body return $ case nonEmpty commonPatterns of diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader.hs b/src/Juvix/Compiler/Pipeline/Package/Loader.hs index 143efb2639..fbd2499f10 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader.hs @@ -83,7 +83,7 @@ toConcrete t p = run . runReader l $ do _typeSigRetType <- Just <$> expressionAtoms' (packageTypeIdentifier :| []) name' <- symbol Str.package _typeSigColonKw <- Irrelevant . Just <$> kw kwColon - let _signBody = (t ^. packageDescriptionTypeTransform) p + let _functionDefBody = (t ^. packageDescriptionTypeTransform) p _functionDefTypesig = TypeSig { _typeSigArgs = [], @@ -100,7 +100,7 @@ toConcrete t p = run . runReader l $ do _signCoercion = Nothing, _functionDefBuiltin = Nothing, _functionDefName = FunctionDefName name', - _signBody, + _functionDefBody, _functionDefTypesig } ) From 12f143dac1b72e6bcf7d1059845f4aadd2565925 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Fri, 29 Nov 2024 16:47:59 +0100 Subject: [PATCH 6/9] functionDefTerminating --- src/Juvix/Compiler/Concrete/Gen.hs | 2 +- src/Juvix/Compiler/Concrete/Language/Base.hs | 8 ++++---- src/Juvix/Compiler/Concrete/Translation/FromSource.hs | 2 +- src/Juvix/Compiler/Internal/Translation/FromConcrete.hs | 2 +- src/Juvix/Compiler/Pipeline/Package/Loader.hs | 2 +- 5 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Juvix/Compiler/Concrete/Gen.hs b/src/Juvix/Compiler/Concrete/Gen.hs index 238d681f5c..fed3018524 100644 --- a/src/Juvix/Compiler/Concrete/Gen.hs +++ b/src/Juvix/Compiler/Concrete/Gen.hs @@ -38,7 +38,7 @@ simplestFunctionDef funName funBody = _functionDefDoc = Nothing, _functionDefPragmas = Nothing, _functionDefBuiltin = Nothing, - _signTerminating = Nothing, + _functionDefTerminating = Nothing, _signInstance = Nothing, _signCoercion = Nothing } diff --git a/src/Juvix/Compiler/Concrete/Language/Base.hs b/src/Juvix/Compiler/Concrete/Language/Base.hs index 9b0f79a7da..11fb7b3ecd 100644 --- a/src/Juvix/Compiler/Concrete/Language/Base.hs +++ b/src/Juvix/Compiler/Concrete/Language/Base.hs @@ -729,7 +729,7 @@ instance NFData FunctionDefNameScoped -- functionDefLhs FunctionDef {..} = -- FunctionLhs -- { _funLhsBuiltin = _functionDefBuiltin, --- _funLhsTerminating = _signTerminating, +-- _funLhsTerminating = _functionDefTerminating, -- _funLhsInstance = _signInstance, -- _funLhsCoercion = _signCoercion, -- _funLhsName = _signName, @@ -743,7 +743,7 @@ data FunctionDef (s :: Stage) = FunctionDef _functionDefPragmas :: Maybe ParsedPragmas, _functionDefBuiltin :: Maybe (WithLoc BuiltinFunction), _functionDefBody :: FunctionDefBody s, - _signTerminating :: Maybe KeywordRef, + _functionDefTerminating :: Maybe KeywordRef, _signInstance :: Maybe KeywordRef, _signCoercion :: Maybe KeywordRef } @@ -3072,7 +3072,7 @@ functionDefLhs :: FunctionDef s -> FunctionLhs s functionDefLhs FunctionDef {..} = FunctionLhs { _funLhsBuiltin = _functionDefBuiltin, - _funLhsTerminating = _signTerminating, + _funLhsTerminating = _functionDefTerminating, _funLhsInstance = _signInstance, _funLhsCoercion = _signCoercion, _funLhsName = _functionDefName, @@ -3539,7 +3539,7 @@ instance (SingI s) => HasLoc (FunctionDef s) where (getLoc <$> _functionDefDoc) ?<> (getLoc <$> _functionDefPragmas) ?<> (getLoc <$> _functionDefBuiltin) - ?<> (getLoc <$> _signTerminating) + ?<> (getLoc <$> _functionDefTerminating) ?<> (getLocFunctionSymbolType _functionDefName) <> getLoc _functionDefBody diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs index 908062421b..927154fed2 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs @@ -1447,7 +1447,7 @@ functionDefinition opts _functionDefBuiltin = P.label "" $ FunctionDef { _functionDefName = _funLhsName, _functionDefTypesig = _funLhsTypeSig, - _signTerminating = _funLhsTerminating, + _functionDefTerminating = _funLhsTerminating, _signInstance = _funLhsInstance, _signCoercion = _funLhsCoercion, _functionDefBuiltin = _funLhsBuiltin, diff --git a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs index 4c39038ab7..66d3d5ac80 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs +++ b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs @@ -894,7 +894,7 @@ goFunctionDef :: Sem r [Internal.FunctionDef] goFunctionDef def@FunctionDef {..} = do let _funDefName = goSymbol (_functionDefName ^. functionDefNameScoped) - _funDefTerminating = isJust _signTerminating + _funDefTerminating = isJust _functionDefTerminating _funDefIsInstanceCoercion | isJust _signCoercion = Just Internal.IsInstanceCoercionCoercion | isJust _signInstance = Just Internal.IsInstanceCoercionInstance diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader.hs b/src/Juvix/Compiler/Pipeline/Package/Loader.hs index fbd2499f10..8271b5a9c0 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader.hs @@ -93,7 +93,7 @@ toConcrete t p = run . runReader l $ do return ( StatementFunctionDef FunctionDef - { _signTerminating = Nothing, + { _functionDefTerminating = Nothing, _functionDefPragmas = Nothing, _signInstance = Nothing, _functionDefDoc = Nothing, From f50b7ba11f999a0b35ba51cb449b162a3b06afc7 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Fri, 29 Nov 2024 16:48:29 +0100 Subject: [PATCH 7/9] functionDefInstance --- src/Juvix/Compiler/Concrete/Gen.hs | 2 +- src/Juvix/Compiler/Concrete/Language/Base.hs | 6 +++--- src/Juvix/Compiler/Concrete/Translation/FromSource.hs | 2 +- src/Juvix/Compiler/Internal/Translation/FromConcrete.hs | 2 +- src/Juvix/Compiler/Pipeline/Package/Loader.hs | 2 +- 5 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Juvix/Compiler/Concrete/Gen.hs b/src/Juvix/Compiler/Concrete/Gen.hs index fed3018524..aa260155f8 100644 --- a/src/Juvix/Compiler/Concrete/Gen.hs +++ b/src/Juvix/Compiler/Concrete/Gen.hs @@ -39,7 +39,7 @@ simplestFunctionDef funName funBody = _functionDefPragmas = Nothing, _functionDefBuiltin = Nothing, _functionDefTerminating = Nothing, - _signInstance = Nothing, + _functionDefInstance = Nothing, _signCoercion = Nothing } where diff --git a/src/Juvix/Compiler/Concrete/Language/Base.hs b/src/Juvix/Compiler/Concrete/Language/Base.hs index 11fb7b3ecd..e4933c75ef 100644 --- a/src/Juvix/Compiler/Concrete/Language/Base.hs +++ b/src/Juvix/Compiler/Concrete/Language/Base.hs @@ -730,7 +730,7 @@ instance NFData FunctionDefNameScoped -- FunctionLhs -- { _funLhsBuiltin = _functionDefBuiltin, -- _funLhsTerminating = _functionDefTerminating, --- _funLhsInstance = _signInstance, +-- _funLhsInstance = _functionDefInstance, -- _funLhsCoercion = _signCoercion, -- _funLhsName = _signName, -- _funLhsTypeSig = _functionDefTypesig @@ -744,7 +744,7 @@ data FunctionDef (s :: Stage) = FunctionDef _functionDefBuiltin :: Maybe (WithLoc BuiltinFunction), _functionDefBody :: FunctionDefBody s, _functionDefTerminating :: Maybe KeywordRef, - _signInstance :: Maybe KeywordRef, + _functionDefInstance :: Maybe KeywordRef, _signCoercion :: Maybe KeywordRef } deriving stock (Generic) @@ -3073,7 +3073,7 @@ functionDefLhs FunctionDef {..} = FunctionLhs { _funLhsBuiltin = _functionDefBuiltin, _funLhsTerminating = _functionDefTerminating, - _funLhsInstance = _signInstance, + _funLhsInstance = _functionDefInstance, _funLhsCoercion = _signCoercion, _funLhsName = _functionDefName, _funLhsTypeSig = _functionDefTypesig diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs index 927154fed2..48d40ac1cb 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs @@ -1448,7 +1448,7 @@ functionDefinition opts _functionDefBuiltin = P.label "" $ { _functionDefName = _funLhsName, _functionDefTypesig = _funLhsTypeSig, _functionDefTerminating = _funLhsTerminating, - _signInstance = _funLhsInstance, + _functionDefInstance = _funLhsInstance, _signCoercion = _funLhsCoercion, _functionDefBuiltin = _funLhsBuiltin, _functionDefDoc, diff --git a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs index 66d3d5ac80..692e79f4cc 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs +++ b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs @@ -897,7 +897,7 @@ goFunctionDef def@FunctionDef {..} = do _funDefTerminating = isJust _functionDefTerminating _funDefIsInstanceCoercion | isJust _signCoercion = Just Internal.IsInstanceCoercionCoercion - | isJust _signInstance = Just Internal.IsInstanceCoercionInstance + | isJust _functionDefInstance = Just Internal.IsInstanceCoercionInstance | otherwise = Nothing _funDefCoercion = isJust _signCoercion _funDefBuiltin = (^. withLocParam) <$> _functionDefBuiltin diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader.hs b/src/Juvix/Compiler/Pipeline/Package/Loader.hs index 8271b5a9c0..52bd18c5ae 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader.hs @@ -95,7 +95,7 @@ toConcrete t p = run . runReader l $ do FunctionDef { _functionDefTerminating = Nothing, _functionDefPragmas = Nothing, - _signInstance = Nothing, + _functionDefInstance = Nothing, _functionDefDoc = Nothing, _signCoercion = Nothing, _functionDefBuiltin = Nothing, From c90c29db6a1371c84e5e56281ea2f5991f7bb36d Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Fri, 29 Nov 2024 16:48:59 +0100 Subject: [PATCH 8/9] functionDefCoercion --- src/Juvix/Compiler/Concrete/Gen.hs | 2 +- src/Juvix/Compiler/Concrete/Language/Base.hs | 6 +++--- src/Juvix/Compiler/Concrete/Translation/FromSource.hs | 2 +- src/Juvix/Compiler/Internal/Translation/FromConcrete.hs | 4 ++-- src/Juvix/Compiler/Pipeline/Package/Loader.hs | 2 +- 5 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Juvix/Compiler/Concrete/Gen.hs b/src/Juvix/Compiler/Concrete/Gen.hs index aa260155f8..2775dda9f6 100644 --- a/src/Juvix/Compiler/Concrete/Gen.hs +++ b/src/Juvix/Compiler/Concrete/Gen.hs @@ -40,7 +40,7 @@ simplestFunctionDef funName funBody = _functionDefBuiltin = Nothing, _functionDefTerminating = Nothing, _functionDefInstance = Nothing, - _signCoercion = Nothing + _functionDefCoercion = Nothing } where name :: FunctionSymbolType s diff --git a/src/Juvix/Compiler/Concrete/Language/Base.hs b/src/Juvix/Compiler/Concrete/Language/Base.hs index e4933c75ef..8af981974c 100644 --- a/src/Juvix/Compiler/Concrete/Language/Base.hs +++ b/src/Juvix/Compiler/Concrete/Language/Base.hs @@ -731,7 +731,7 @@ instance NFData FunctionDefNameScoped -- { _funLhsBuiltin = _functionDefBuiltin, -- _funLhsTerminating = _functionDefTerminating, -- _funLhsInstance = _functionDefInstance, --- _funLhsCoercion = _signCoercion, +-- _funLhsCoercion = _functionDefCoercion, -- _funLhsName = _signName, -- _funLhsTypeSig = _functionDefTypesig -- } @@ -745,7 +745,7 @@ data FunctionDef (s :: Stage) = FunctionDef _functionDefBody :: FunctionDefBody s, _functionDefTerminating :: Maybe KeywordRef, _functionDefInstance :: Maybe KeywordRef, - _signCoercion :: Maybe KeywordRef + _functionDefCoercion :: Maybe KeywordRef } deriving stock (Generic) @@ -3074,7 +3074,7 @@ functionDefLhs FunctionDef {..} = { _funLhsBuiltin = _functionDefBuiltin, _funLhsTerminating = _functionDefTerminating, _funLhsInstance = _functionDefInstance, - _funLhsCoercion = _signCoercion, + _funLhsCoercion = _functionDefCoercion, _funLhsName = _functionDefName, _funLhsTypeSig = _functionDefTypesig } diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs index 48d40ac1cb..7b9100cbf2 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs @@ -1449,7 +1449,7 @@ functionDefinition opts _functionDefBuiltin = P.label "" $ _functionDefTypesig = _funLhsTypeSig, _functionDefTerminating = _funLhsTerminating, _functionDefInstance = _funLhsInstance, - _signCoercion = _funLhsCoercion, + _functionDefCoercion = _funLhsCoercion, _functionDefBuiltin = _funLhsBuiltin, _functionDefDoc, _functionDefPragmas, diff --git a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs index 692e79f4cc..74cf0c73d7 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs +++ b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs @@ -896,10 +896,10 @@ goFunctionDef def@FunctionDef {..} = do let _funDefName = goSymbol (_functionDefName ^. functionDefNameScoped) _funDefTerminating = isJust _functionDefTerminating _funDefIsInstanceCoercion - | isJust _signCoercion = Just Internal.IsInstanceCoercionCoercion + | isJust _functionDefCoercion = Just Internal.IsInstanceCoercionCoercion | isJust _functionDefInstance = Just Internal.IsInstanceCoercionInstance | otherwise = Nothing - _funDefCoercion = isJust _signCoercion + _funDefCoercion = isJust _functionDefCoercion _funDefBuiltin = (^. withLocParam) <$> _functionDefBuiltin _funDefType <- goDefType (functionDefLhs def) _funDefPragmas <- goPragmas _functionDefPragmas diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader.hs b/src/Juvix/Compiler/Pipeline/Package/Loader.hs index 52bd18c5ae..237aa6d397 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader.hs @@ -97,7 +97,7 @@ toConcrete t p = run . runReader l $ do _functionDefPragmas = Nothing, _functionDefInstance = Nothing, _functionDefDoc = Nothing, - _signCoercion = Nothing, + _functionDefCoercion = Nothing, _functionDefBuiltin = Nothing, _functionDefName = FunctionDefName name', _functionDefBody, From 019bc07b35309956e7173fdab2d7d79d49508d83 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Fri, 29 Nov 2024 17:58:36 +0100 Subject: [PATCH 9/9] make FunctionLhs a field of FunctionDef --- .../Backend/Html/Translation/FromTyped.hs | 2 +- .../Concrete/Data/NameSignature/Builder.hs | 2 +- src/Juvix/Compiler/Concrete/Extra.hs | 2 +- src/Juvix/Compiler/Concrete/Gen.hs | 36 ++++++----- src/Juvix/Compiler/Concrete/Language/Base.hs | 62 ++++++++----------- src/Juvix/Compiler/Concrete/Print/Base.hs | 2 +- .../FromParsed/Analysis/Scoping.hs | 22 ++++--- .../Concrete/Translation/FromSource.hs | 15 ++--- .../Internal/Translation/FromConcrete.hs | 20 +++--- src/Juvix/Compiler/Pipeline/Package/Loader.hs | 22 ++++--- 10 files changed, 93 insertions(+), 92 deletions(-) diff --git a/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs b/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs index 920469c05e..447b6f286d 100644 --- a/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs +++ b/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs @@ -545,7 +545,7 @@ goDeriving def = do goFunctionDef :: forall r. (Members '[Reader HtmlOptions] r) => FunctionDef 'Scoped -> Sem r Html goFunctionDef def = do - sig <- ppHelper (ppCode (functionDefLhs def)) + sig <- ppHelper (ppCode (def ^. functionDefLhs)) defHeader (def ^. functionDefName . functionDefNameScoped) sig (def ^. functionDefDoc) goInductive :: forall r. (Members '[Reader HtmlOptions] r) => InductiveDef 'Scoped -> Sem r Html diff --git a/src/Juvix/Compiler/Concrete/Data/NameSignature/Builder.hs b/src/Juvix/Compiler/Concrete/Data/NameSignature/Builder.hs index ace4a4ec24..001dc016e5 100644 --- a/src/Juvix/Compiler/Concrete/Data/NameSignature/Builder.hs +++ b/src/Juvix/Compiler/Concrete/Data/NameSignature/Builder.hs @@ -68,7 +68,7 @@ instance (SingI s) => HasNameSignature s (FunctionLhs s) where addArgs FunctionLhs {..} = addArgs _funLhsTypeSig instance (SingI s) => HasNameSignature s (FunctionDef s) where - addArgs = addArgs . functionDefLhs + addArgs = addArgs . (^. functionDefLhs) instance (SingI s) => HasNameSignature s (InductiveDef s, ConstructorDef s) where addArgs :: diff --git a/src/Juvix/Compiler/Concrete/Extra.hs b/src/Juvix/Compiler/Concrete/Extra.hs index 61bbdd0072..42859b64a3 100644 --- a/src/Juvix/Compiler/Concrete/Extra.hs +++ b/src/Juvix/Compiler/Concrete/Extra.hs @@ -115,4 +115,4 @@ isLhsFunctionLike FunctionLhs {..} = notNull (_funLhsTypeSig ^. typeSigArgs) isFunctionLike :: FunctionDef 'Parsed -> Bool isFunctionLike d@FunctionDef {..} = - isLhsFunctionLike (functionDefLhs d) || (not . isBodyExpression) _functionDefBody + isLhsFunctionLike (d ^. functionDefLhs) || (not . isBodyExpression) _functionDefBody diff --git a/src/Juvix/Compiler/Concrete/Gen.hs b/src/Juvix/Compiler/Concrete/Gen.hs index 2775dda9f6..828f67bfeb 100644 --- a/src/Juvix/Compiler/Concrete/Gen.hs +++ b/src/Juvix/Compiler/Concrete/Gen.hs @@ -26,22 +26,26 @@ simplestFunctionDefParsed funNameTxt funBody = do simplestFunctionDef :: forall s. (SingI s) => FunctionName s -> ExpressionType s -> FunctionDef s simplestFunctionDef funName funBody = - FunctionDef - { _functionDefName = name, - _functionDefBody = SigBodyExpression funBody, - _functionDefTypesig = - TypeSig - { _typeSigColonKw = Irrelevant Nothing, - _typeSigArgs = [], - _typeSigRetType = Nothing - }, - _functionDefDoc = Nothing, - _functionDefPragmas = Nothing, - _functionDefBuiltin = Nothing, - _functionDefTerminating = Nothing, - _functionDefInstance = Nothing, - _functionDefCoercion = Nothing - } + let lhs = + FunctionLhs + { _funLhsName = name, + _funLhsTypeSig = + TypeSig + { _typeSigColonKw = Irrelevant Nothing, + _typeSigArgs = [], + _typeSigRetType = Nothing + }, + _funLhsBuiltin = Nothing, + _funLhsTerminating = Nothing, + _funLhsInstance = Nothing, + _funLhsCoercion = Nothing + } + in FunctionDef + { _functionDefBody = SigBodyExpression funBody, + _functionDefLhs = lhs, + _functionDefDoc = Nothing, + _functionDefPragmas = Nothing + } where name :: FunctionSymbolType s name = case sing :: SStage s of diff --git a/src/Juvix/Compiler/Concrete/Language/Base.hs b/src/Juvix/Compiler/Concrete/Language/Base.hs index 8af981974c..a93ebe0e1e 100644 --- a/src/Juvix/Compiler/Concrete/Language/Base.hs +++ b/src/Juvix/Compiler/Concrete/Language/Base.hs @@ -725,27 +725,11 @@ instance Serialize FunctionDefNameScoped instance NFData FunctionDefNameScoped --- functionDefLhs :: FunctionDef s -> FunctionLhs s --- functionDefLhs FunctionDef {..} = --- FunctionLhs --- { _funLhsBuiltin = _functionDefBuiltin, --- _funLhsTerminating = _functionDefTerminating, --- _funLhsInstance = _functionDefInstance, --- _funLhsCoercion = _functionDefCoercion, --- _funLhsName = _signName, --- _funLhsTypeSig = _functionDefTypesig --- } - data FunctionDef (s :: Stage) = FunctionDef - { _functionDefName :: FunctionSymbolType s, - _functionDefTypesig :: TypeSig s, - _functionDefDoc :: Maybe (Judoc s), + { _functionDefDoc :: Maybe (Judoc s), _functionDefPragmas :: Maybe ParsedPragmas, - _functionDefBuiltin :: Maybe (WithLoc BuiltinFunction), - _functionDefBody :: FunctionDefBody s, - _functionDefTerminating :: Maybe KeywordRef, - _functionDefInstance :: Maybe KeywordRef, - _functionDefCoercion :: Maybe KeywordRef + _functionDefLhs :: FunctionLhs s, + _functionDefBody :: FunctionDefBody s } deriving stock (Generic) @@ -3068,16 +3052,23 @@ makePrisms ''NamedArgumentNew makePrisms ''ConstructorRhs makePrisms ''FunctionDefNameParsed -functionDefLhs :: FunctionDef s -> FunctionLhs s -functionDefLhs FunctionDef {..} = - FunctionLhs - { _funLhsBuiltin = _functionDefBuiltin, - _funLhsTerminating = _functionDefTerminating, - _funLhsInstance = _functionDefInstance, - _funLhsCoercion = _functionDefCoercion, - _funLhsName = _functionDefName, - _funLhsTypeSig = _functionDefTypesig - } +functionDefBuiltin :: Lens' (FunctionDef s) (Maybe (WithLoc BuiltinFunction)) +functionDefBuiltin = functionDefLhs . funLhsBuiltin + +functionDefTerminating :: Lens' (FunctionDef s) (Maybe KeywordRef) +functionDefTerminating = functionDefLhs . funLhsTerminating + +functionDefInstance :: Lens' (FunctionDef s) (Maybe KeywordRef) +functionDefInstance = functionDefLhs . funLhsInstance + +functionDefCoercion :: Lens' (FunctionDef s) (Maybe KeywordRef) +functionDefCoercion = functionDefLhs . funLhsCoercion + +functionDefName :: Lens' (FunctionDef s) (FunctionSymbolType s) +functionDefName = functionDefLhs . funLhsName + +functionDefTypeSig :: Lens' (FunctionDef s) (TypeSig s) +functionDefTypeSig = functionDefLhs . funLhsTypeSig fixityFieldHelper :: SimpleGetter (ParsedFixityFields s) (Maybe a) -> SimpleGetter (ParsedFixityInfo s) (Maybe a) fixityFieldHelper l = to (^? fixityFields . _Just . l . _Just) @@ -3536,12 +3527,13 @@ instance (SingI s) => HasLoc (FunctionDefBody s) where instance (SingI s) => HasLoc (FunctionDef s) where getLoc FunctionDef {..} = - (getLoc <$> _functionDefDoc) - ?<> (getLoc <$> _functionDefPragmas) - ?<> (getLoc <$> _functionDefBuiltin) - ?<> (getLoc <$> _functionDefTerminating) - ?<> (getLocFunctionSymbolType _functionDefName) - <> getLoc _functionDefBody + let FunctionLhs {..} = _functionDefLhs + in (getLoc <$> _functionDefDoc) + ?<> (getLoc <$> _functionDefPragmas) + ?<> (getLoc <$> _funLhsBuiltin) + ?<> (getLoc <$> _funLhsTerminating) + ?<> (getLocFunctionSymbolType _funLhsName) + <> getLoc _functionDefBody instance HasLoc (Example s) where getLoc e = e ^. exampleLoc diff --git a/src/Juvix/Compiler/Concrete/Print/Base.hs b/src/Juvix/Compiler/Concrete/Print/Base.hs index 50148e9674..8f61ac9c28 100644 --- a/src/Juvix/Compiler/Concrete/Print/Base.hs +++ b/src/Juvix/Compiler/Concrete/Print/Base.hs @@ -1207,7 +1207,7 @@ instance (SingI s) => PrettyPrint (FunctionDef s) where ppCode fun@FunctionDef {..} = do let doc' :: Maybe (Sem r ()) = ppCode <$> _functionDefDoc pragmas' :: Maybe (Sem r ()) = ppCode <$> _functionDefPragmas - sig' = ppCode (functionDefLhs fun) + sig' = ppCode (fun ^. functionDefLhs) body' = case _functionDefBody of SigBodyExpression e -> space <> ppCode Kw.kwAssign <> oneLineOrNext (ppTopExpressionType e) SigBodyClauses k -> ppPipeBranches False Top ppFunctionClause k diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs index 3bbd409adc..901d37ce8b 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs @@ -439,7 +439,7 @@ reserveFunctionLikeSymbol :: Sem r () reserveFunctionLikeSymbol f = when (P.isFunctionLike f) $ - void (reserveFunctionSymbol (functionDefLhs f)) + void (reserveFunctionSymbol (f ^. functionDefLhs)) bindFixitySymbol :: (Members '[Error ScoperError, NameIdGen, State ScoperSyntax, State Scope, InfoTableBuilder, Reader InfoTable, State ScoperState, Reader BindingStrategy] r) => @@ -1192,18 +1192,19 @@ checkFunctionDef :: FunctionDef 'Parsed -> Sem r (FunctionDef 'Scoped) checkFunctionDef fdef@FunctionDef {..} = do + let FunctionLhs {..} = _functionDefLhs sigDoc' <- mapM checkJudoc _functionDefDoc (sig', sigBody') <- withLocalScope $ do - a' <- checkTypeSig _functionDefTypesig + a' <- checkTypeSig _funLhsTypeSig b' <- checkBody return (a', b') - whenJust (functionSymbolPattern _functionDefName) reservePatternFunctionSymbols - sigName' <- case _functionDefName of + whenJust (functionSymbolPattern _funLhsName) reservePatternFunctionSymbols + sigName' <- case _funLhsName of FunctionDefName name -> do name' <- if | P.isFunctionLike fdef -> getReservedDefinitionSymbol name - | otherwise -> reserveFunctionSymbol (functionDefLhs fdef) + | otherwise -> reserveFunctionSymbol (fdef ^. functionDefLhs) return FunctionDefNameScoped { _functionDefNameScoped = name', @@ -1217,12 +1218,17 @@ checkFunctionDef fdef@FunctionDef {..} = do { _functionDefNameScoped = name', _functionDefNamePattern = Just p' } - let def = + let lhs' = + FunctionLhs + { _funLhsName = sigName', + _funLhsTypeSig = sig', + .. + } + def = FunctionDef - { _functionDefName = sigName', + { _functionDefLhs = lhs', _functionDefDoc = sigDoc', _functionDefBody = sigBody', - _functionDefTypesig = sig', .. } registerNameSignature (sigName' ^. functionDefNameScoped . S.nameId) def diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs index 7b9100cbf2..744a2f17c1 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs @@ -1433,29 +1433,24 @@ functionDefinition :: ParsecS r (FunctionDef 'Parsed) functionDefinition opts _functionDefBuiltin = P.label "" $ do off0 <- P.getOffset - FunctionLhs {..} <- functionDefinitionLhs opts _functionDefBuiltin + lhs <- functionDefinitionLhs opts _functionDefBuiltin off <- P.getOffset _functionDefDoc <- getJudoc _functionDefPragmas <- getPragmas _functionDefBody <- parseBody unless - ( isJust (_funLhsTypeSig ^. typeSigColonKw . unIrrelevant) - || (P.isBodyExpression _functionDefBody && null (_funLhsTypeSig ^. typeSigArgs)) + ( isJust (lhs ^. funLhsTypeSig . typeSigColonKw . unIrrelevant) + || (P.isBodyExpression _functionDefBody && null (lhs ^. funLhsTypeSig . typeSigArgs)) ) $ parseFailure off "expected result type" let fdef = FunctionDef - { _functionDefName = _funLhsName, - _functionDefTypesig = _funLhsTypeSig, - _functionDefTerminating = _funLhsTerminating, - _functionDefInstance = _funLhsInstance, - _functionDefCoercion = _funLhsCoercion, - _functionDefBuiltin = _funLhsBuiltin, + { _functionDefLhs = lhs, _functionDefDoc, _functionDefPragmas, _functionDefBody } - when (isNothing (_funLhsName ^? _FunctionDefName) && P.isFunctionLike fdef) $ + when (isNothing (lhs ^? funLhsName . _FunctionDefName) && P.isFunctionLike fdef) $ parseFailure off0 "expected function name" return fdef where diff --git a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs index 74cf0c73d7..505f9678b1 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs +++ b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs @@ -893,22 +893,22 @@ goFunctionDef :: FunctionDef 'Scoped -> Sem r [Internal.FunctionDef] goFunctionDef def@FunctionDef {..} = do - let _funDefName = goSymbol (_functionDefName ^. functionDefNameScoped) - _funDefTerminating = isJust _functionDefTerminating + let _funDefName = goSymbol (def ^. functionDefName . functionDefNameScoped) + _funDefTerminating = isJust (def ^. functionDefTerminating) _funDefIsInstanceCoercion - | isJust _functionDefCoercion = Just Internal.IsInstanceCoercionCoercion - | isJust _functionDefInstance = Just Internal.IsInstanceCoercionInstance + | isJust (def ^. functionDefCoercion) = Just Internal.IsInstanceCoercionCoercion + | isJust (def ^. functionDefInstance) = Just Internal.IsInstanceCoercionInstance | otherwise = Nothing - _funDefCoercion = isJust _functionDefCoercion - _funDefBuiltin = (^. withLocParam) <$> _functionDefBuiltin - _funDefType <- goDefType (functionDefLhs def) + _funDefCoercion = isJust (def ^. functionDefCoercion) + _funDefBuiltin = (^. withLocParam) <$> (def ^. functionDefBuiltin) + _funDefType <- goDefType (def ^. functionDefLhs) _funDefPragmas <- goPragmas _functionDefPragmas _funDefBody <- goBody _funDefArgsInfo <- goArgsInfo _funDefName let _funDefDocComment = fmap ppPrintJudoc _functionDefDoc fun = Internal.FunctionDef {..} - whenJust _functionDefBuiltin (checkBuiltinFunction fun . (^. withLocParam)) - case _functionDefName ^. functionDefNamePattern of + whenJust (def ^. functionDefBuiltin) (checkBuiltinFunction fun . (^. withLocParam)) + case def ^. functionDefName . functionDefNamePattern of Just pat -> do pat' <- goPatternArg pat (fun :) <$> Internal.genPatternDefs _funDefName pat' @@ -917,7 +917,7 @@ goFunctionDef def@FunctionDef {..} = do where goBody :: Sem r Internal.Expression goBody = do - commonPatterns <- concatMapM (fmap toList . argToPattern) (_functionDefTypesig ^. typeSigArgs) + commonPatterns <- concatMapM (fmap toList . argToPattern) (def ^. functionDefTypeSig . typeSigArgs) let goClause :: FunctionClause 'Scoped -> Sem r Internal.LambdaClause goClause FunctionClause {..} = do _lambdaBody <- goExpression _clausenBody diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader.hs b/src/Juvix/Compiler/Pipeline/Package/Loader.hs index 237aa6d397..41ef36dc1b 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader.hs @@ -84,24 +84,28 @@ toConcrete t p = run . runReader l $ do name' <- symbol Str.package _typeSigColonKw <- Irrelevant . Just <$> kw kwColon let _functionDefBody = (t ^. packageDescriptionTypeTransform) p - _functionDefTypesig = + _funLhsTypeSig = TypeSig { _typeSigArgs = [], _typeSigRetType, _typeSigColonKw } + lhs = + FunctionLhs + { _funLhsTerminating = Nothing, + _funLhsCoercion = Nothing, + _funLhsBuiltin = Nothing, + _funLhsName = FunctionDefName name', + _funLhsInstance = Nothing, + _funLhsTypeSig + } return ( StatementFunctionDef FunctionDef - { _functionDefTerminating = Nothing, - _functionDefPragmas = Nothing, - _functionDefInstance = Nothing, + { _functionDefPragmas = Nothing, + _functionDefLhs = lhs, _functionDefDoc = Nothing, - _functionDefCoercion = Nothing, - _functionDefBuiltin = Nothing, - _functionDefName = FunctionDefName name', - _functionDefBody, - _functionDefTypesig + _functionDefBody } )