diff --git a/examples/demo/Package.juvix b/examples/demo/Package.juvix index 91156a9c7c..95fc82192b 100644 --- a/examples/demo/Package.juvix +++ b/examples/demo/Package.juvix @@ -3,5 +3,7 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage - {name := "Demo"; version := mkVersion 0 1 0}; + defaultPackage@?{ + name := "Demo"; + version := mkVersion 0 1 0 + }; diff --git a/examples/midsquare/Package.juvix b/examples/midsquare/Package.juvix index cbcc603540..564be67861 100644 --- a/examples/midsquare/Package.juvix +++ b/examples/midsquare/Package.juvix @@ -3,5 +3,7 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage - {name := "midsquare"; version := mkVersion 0 1 0}; + defaultPackage@?{ + name := "midsquare"; + version := mkVersion 0 1 0 + }; diff --git a/examples/milestone/Bank/Package.juvix b/examples/milestone/Bank/Package.juvix index 682ffac642..f0b0d1db0f 100644 --- a/examples/milestone/Bank/Package.juvix +++ b/examples/milestone/Bank/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {name := "bank"}; +package : Package := + defaultPackage@?{ + name := "bank" + }; diff --git a/examples/milestone/Collatz/Package.juvix b/examples/milestone/Collatz/Package.juvix index 616ad26f18..87fe97ccb4 100644 --- a/examples/milestone/Collatz/Package.juvix +++ b/examples/milestone/Collatz/Package.juvix @@ -3,7 +3,8 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage - {name := "Collatz"; - version := mkVersion 0 1 0; - main := just "Collatz.juvix"}; + defaultPackage@?{ + name := "Collatz"; + version := mkVersion 0 1 0; + main := just "Collatz.juvix" + }; diff --git a/examples/milestone/Fibonacci/Package.juvix b/examples/milestone/Fibonacci/Package.juvix index a2902a0a6e..eb009b9675 100644 --- a/examples/milestone/Fibonacci/Package.juvix +++ b/examples/milestone/Fibonacci/Package.juvix @@ -3,7 +3,8 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage - {name := "Fibonacci"; - version := mkVersion 0 1 0; - main := just "Fibonacci.juvix"}; + defaultPackage@?{ + name := "Fibonacci"; + version := mkVersion 0 1 0; + main := just "Fibonacci.juvix" + }; diff --git a/examples/milestone/Hanoi/Package.juvix b/examples/milestone/Hanoi/Package.juvix index 85e851a2ad..4588aeb0f1 100644 --- a/examples/milestone/Hanoi/Package.juvix +++ b/examples/milestone/Hanoi/Package.juvix @@ -3,7 +3,8 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage - {name := "Hanoi"; - version := mkVersion 0 1 0; - main := just "Hanoi.juvix"}; + defaultPackage@?{ + name := "Hanoi"; + version := mkVersion 0 1 0; + main := just "Hanoi.juvix" + }; diff --git a/examples/milestone/HelloWorld/Package.juvix b/examples/milestone/HelloWorld/Package.juvix index 8c3e25ab4c..7960036eaf 100644 --- a/examples/milestone/HelloWorld/Package.juvix +++ b/examples/milestone/HelloWorld/Package.juvix @@ -3,7 +3,8 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage - {name := "HelloWorld"; - version := mkVersion 0 1 0; - main := just "HelloWorld.juvix"}; + defaultPackage@?{ + name := "HelloWorld"; + version := mkVersion 0 1 0; + main := just "HelloWorld.juvix" + }; diff --git a/examples/milestone/PascalsTriangle/Package.juvix b/examples/milestone/PascalsTriangle/Package.juvix index 95eaeac96a..a740b3e86b 100644 --- a/examples/milestone/PascalsTriangle/Package.juvix +++ b/examples/milestone/PascalsTriangle/Package.juvix @@ -3,7 +3,8 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage - {name := "PascalsTriangle"; - version := mkVersion 0 1 0; - main := just "PascalsTriangle.juvix"}; + defaultPackage@?{ + name := "PascalsTriangle"; + version := mkVersion 0 1 0; + main := just "PascalsTriangle.juvix" + }; diff --git a/examples/milestone/TicTacToe/Package.juvix b/examples/milestone/TicTacToe/Package.juvix index ee9b03f58c..ff3cda7035 100644 --- a/examples/milestone/TicTacToe/Package.juvix +++ b/examples/milestone/TicTacToe/Package.juvix @@ -3,7 +3,8 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage - {name := "TicTacToe"; - version := mkVersion 0 1 0; - main := just "CLI/TicTacToe.juvix"}; + defaultPackage@?{ + name := "TicTacToe"; + version := mkVersion 0 1 0; + main := just "CLI/TicTacToe.juvix" + }; diff --git a/examples/milestone/Tutorial/Package.juvix b/examples/milestone/Tutorial/Package.juvix index 11463be5e9..3c4a4a3ec4 100644 --- a/examples/milestone/Tutorial/Package.juvix +++ b/examples/milestone/Tutorial/Package.juvix @@ -3,5 +3,7 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage - {name := "Tutorial"; version := mkVersion 0 1 0}; + defaultPackage@?{ + name := "Tutorial"; + version := mkVersion 0 1 0 + }; diff --git a/include/package/PackageDescription/V1.juvix b/include/package/PackageDescription/V1.juvix index e6c1396945..85dae9ea3b 100644 --- a/include/package/PackageDescription/V1.juvix +++ b/include/package/PackageDescription/V1.juvix @@ -44,22 +44,28 @@ type Dependency := defaultStdlib; --- Construct a ;Package; with useful default arguments. -defaultPackage {name : String := "my-project"} {version : SemVer := defaultVersion} {dependencies : List - Dependency := [defaultStdlib]} {main : Maybe - String := nothing} {buildDir : Maybe String := nothing} +defaultPackage + {name : String := "my-project"} + {version : SemVer := defaultVersion} + {dependencies : List Dependency := [defaultStdlib]} + {main : Maybe String := nothing} + {buildDir : Maybe String := nothing} : Package := mkPackage name version dependencies main buildDir; --- Construct a ;SemVer; with useful default arguments. -mkVersion (major minor patch : Nat) {release : Maybe - String := nothing} {meta : Maybe String := nothing} +mkVersion + (major' minor' patch' : Nat) + {release' : Maybe String := nothing} + {meta' : Maybe String := nothing} : SemVer := - mkSemVer - (major := major; - minor := minor; - patch := patch; - release := release; - meta := meta); + mkSemVer@?{ + major := major'; + minor := minor'; + patch := patch'; + release := release'; + meta := meta' + }; --- The default version used in `defaultPackage`. defaultVersion : SemVer := mkVersion 0 0 0; diff --git a/include/package/PackageDescription/V2.juvix b/include/package/PackageDescription/V2.juvix index ec04b2b96e..44d27e471f 100644 --- a/include/package/PackageDescription/V2.juvix +++ b/include/package/PackageDescription/V2.juvix @@ -44,22 +44,28 @@ type Dependency := defaultStdlib; --- Construct a ;Package; with useful default arguments. -defaultPackage {name : String := "my-project"} {version : SemVer := defaultVersion} {dependencies : List - Dependency := [defaultStdlib]} {main : Maybe - String := nothing} {buildDir : Maybe String := nothing} +defaultPackage + {name : String := "my-project"} + {version : SemVer := defaultVersion} + {dependencies : List Dependency := [defaultStdlib]} + {main : Maybe String := nothing} + {buildDir : Maybe String := nothing} : Package := mkPackage name version dependencies main buildDir; --- Construct a ;SemVer; with useful default arguments. -mkVersion (major minor patch : Nat) {release : Maybe - String := nothing} {meta : Maybe String := nothing} +mkVersion + (major' minor' patch' : Nat) + {release' : Maybe String := nothing} + {meta' : Maybe String := nothing} : SemVer := - mkSemVer - (major := major; - minor := minor; - patch := patch; - release := release; - meta := meta); + mkSemVer@?{ + major := major'; + minor := minor'; + patch := patch'; + release := release'; + meta := meta' + }; --- The default version used in `defaultPackage`. defaultVersion : SemVer := mkVersion 0 0 0; diff --git a/src/Juvix/Compiler/Concrete/Gen.hs b/src/Juvix/Compiler/Concrete/Gen.hs index d7fb4fffb4..e6eb81960b 100644 --- a/src/Juvix/Compiler/Concrete/Gen.hs +++ b/src/Juvix/Compiler/Concrete/Gen.hs @@ -5,7 +5,7 @@ module Juvix.Compiler.Concrete.Gen where import Juvix.Compiler.Concrete.Keywords -import Juvix.Compiler.Concrete.Language +import Juvix.Compiler.Concrete.Language.Base import Juvix.Prelude kw :: (Members '[Reader Interval] r) => Keyword -> Sem r KeywordRef @@ -18,6 +18,22 @@ kw k = do _keywordRefInterval = loc } +simplestFunctionDef :: FunctionName s -> ExpressionType s -> FunctionDef s +simplestFunctionDef funName funBody = + FunctionDef + { _signName = funName, + _signBody = SigBodyExpression funBody, + _signColonKw = Irrelevant Nothing, + _signArgs = [], + _signRetType = Nothing, + _signDoc = Nothing, + _signPragmas = Nothing, + _signBuiltin = Nothing, + _signTerminating = Nothing, + _signInstance = Nothing, + _signCoercion = Nothing + } + smallUniverseExpression :: forall s r. (SingI s) => (Members '[Reader Interval] r) => Sem r (ExpressionType s) smallUniverseExpression = do loc <- ask @Interval @@ -29,6 +45,16 @@ smallUniverseExpression = do _expressionAtoms = pure (AtomUniverse (smallUniverse loc)) } +isExhaustive :: (Member (Reader Interval) r) => Bool -> Sem r IsExhaustive +isExhaustive _isExhaustive = do + _isExhaustiveKw <- + Irrelevant + <$> if + | _isExhaustive -> kw kwAt + | otherwise -> kw kwAtQuestion + + return IsExhaustive {..} + symbol :: (Member (Reader Interval) r) => Text -> Sem r Symbol symbol t = do l <- ask @@ -39,12 +65,12 @@ expressionAtoms' _expressionAtoms = do _expressionAtomsLoc <- Irrelevant <$> ask return ExpressionAtoms {..} -namedArgument :: (Member (Reader Interval) r) => Text -> NonEmpty (ExpressionAtom 'Parsed) -> Sem r (NamedArgument 'Parsed) +namedArgument :: (Member (Reader Interval) r) => Text -> NonEmpty (ExpressionAtom 'Parsed) -> Sem r (NamedArgumentAssign 'Parsed) namedArgument n as = do _namedArgValue <- expressionAtoms' as _namedArgName <- symbol n _namedArgAssignKw <- Irrelevant <$> kw kwAssign - return NamedArgument {..} + return NamedArgumentAssign {..} literalString :: (Member (Reader Interval) r) => Text -> Sem r (ExpressionAtom s) literalString t = do @@ -59,7 +85,7 @@ braced a = do l <- ask AtomBraces . WithLoc l <$> expressionAtoms' a -argumentBlock :: (Member (Reader Interval) r) => IsImplicit -> NonEmpty (NamedArgument 'Parsed) -> Sem r (ArgumentBlock 'Parsed) +argumentBlock :: (Member (Reader Interval) r) => IsImplicit -> NonEmpty (NamedArgumentAssign 'Parsed) -> Sem r (ArgumentBlock 'Parsed) argumentBlock i as = do parenL <- kw delimL parenR <- kw delimR @@ -109,5 +135,8 @@ mkList as = do } ) -functionDefExpression :: (Member (Reader Interval) r) => NonEmpty (ExpressionAtom 'Parsed) -> Sem r (FunctionDefBody 'Parsed) +functionDefExpression :: + (Member (Reader Interval) r) => + NonEmpty (ExpressionAtom 'Parsed) -> + Sem r (FunctionDefBody 'Parsed) functionDefExpression exp = SigBodyExpression <$> expressionAtoms' exp diff --git a/src/Juvix/Compiler/Concrete/Language.hs b/src/Juvix/Compiler/Concrete/Language.hs index f6417b2a03..eec3468ae2 100644 --- a/src/Juvix/Compiler/Concrete/Language.hs +++ b/src/Juvix/Compiler/Concrete/Language.hs @@ -1,3441 +1,8 @@ -{-# LANGUAGE UndecidableInstances #-} - module Juvix.Compiler.Concrete.Language - ( module Juvix.Compiler.Concrete.Language, - module Juvix.Data.FixityInfo, - module Juvix.Compiler.Concrete.Data.IsOpenShort, - module Juvix.Compiler.Concrete.Data.LocalModuleOrigin, - module Juvix.Data.IteratorInfo, - module Juvix.Compiler.Concrete.Data.IfBranchKind, - module Juvix.Compiler.Concrete.Data.Name, - module Juvix.Compiler.Concrete.Data.Stage, - module Juvix.Compiler.Concrete.Data.NameRef, - module Juvix.Data.Keyword, - module Juvix.Compiler.Concrete.Data.Builtins, - module Juvix.Compiler.Concrete.Data.Literal, - module Juvix.Data, - module Juvix.Compiler.Concrete.Data.VisibilityAnn, - module Juvix.Compiler.Concrete.Data.PublicAnn, - module Juvix.Compiler.Concrete.Data.ModuleIsTop, - module Juvix.Data.Fixity, + ( module Juvix.Compiler.Concrete.Language.Base, + module Juvix.Compiler.Concrete.Language.IsApeInstances, ) where -import Juvix.Compiler.Backend.Markdown.Data.Types (Mk) -import Juvix.Compiler.Concrete.Data.Builtins -import Juvix.Compiler.Concrete.Data.IfBranchKind -import Juvix.Compiler.Concrete.Data.IsOpenShort -import Juvix.Compiler.Concrete.Data.Literal -import Juvix.Compiler.Concrete.Data.LocalModuleOrigin -import Juvix.Compiler.Concrete.Data.ModuleIsTop -import Juvix.Compiler.Concrete.Data.Name -import Juvix.Compiler.Concrete.Data.NameRef -import Juvix.Compiler.Concrete.Data.PublicAnn -import Juvix.Compiler.Concrete.Data.ScopedName qualified as S -import Juvix.Compiler.Concrete.Data.Stage -import Juvix.Compiler.Concrete.Data.VisibilityAnn -import Juvix.Data -import Juvix.Data.Ape.Base as Ape -import Juvix.Data.Fixity -import Juvix.Data.FixityInfo (Arity (..), FixityInfo) -import Juvix.Data.IteratorInfo -import Juvix.Data.Keyword -import Juvix.Data.NameKind -import Juvix.Extra.Serialize as Ser -import Juvix.Parser.Lexer (isDelimiterStr) -import Juvix.Prelude hiding (show) -import Juvix.Prelude.Pretty (Pretty, pretty, prettyText) - -type Delims = Irrelevant (Maybe (KeywordRef, KeywordRef)) - -type RecordUpdateExtraType :: Stage -> GHCType -type family RecordUpdateExtraType s = res | res -> s where - RecordUpdateExtraType 'Parsed = () - RecordUpdateExtraType 'Scoped = RecordUpdateExtra - -type FieldArgIxType :: Stage -> GHCType -type family FieldArgIxType s = res | res -> s where - FieldArgIxType 'Parsed = () - FieldArgIxType 'Scoped = Int - -type SideIfBranchConditionType :: Stage -> IfBranchKind -> GHCType -type family SideIfBranchConditionType s k = res where - SideIfBranchConditionType s 'BranchIfBool = ExpressionType s - SideIfBranchConditionType _ 'BranchIfElse = () - -type IfBranchConditionType :: Stage -> IfBranchKind -> GHCType -type family IfBranchConditionType s k = res where - IfBranchConditionType s 'BranchIfBool = ExpressionType s - IfBranchConditionType _ 'BranchIfElse = Irrelevant KeywordRef - -type ModuleIdType :: Stage -> ModuleIsTop -> GHCType -type family ModuleIdType s t = res where - ModuleIdType 'Parsed _ = () - ModuleIdType 'Scoped 'ModuleLocal = () - ModuleIdType 'Scoped 'ModuleTop = ModuleId - -type SymbolType :: Stage -> GHCType -type family SymbolType s = res | res -> s where - SymbolType 'Parsed = Symbol - SymbolType 'Scoped = S.Symbol - -type IdentifierType :: Stage -> GHCType -type family IdentifierType s = res | res -> s where - IdentifierType 'Parsed = Name - IdentifierType 'Scoped = ScopedIden - -type HoleType :: Stage -> GHCType -type family HoleType s = res | res -> s where - HoleType 'Parsed = KeywordRef - HoleType 'Scoped = Hole - -type PatternAtomIdenType :: Stage -> GHCType -type family PatternAtomIdenType s = res | res -> s where - PatternAtomIdenType 'Parsed = Name - PatternAtomIdenType 'Scoped = PatternScopedIden - -type ExpressionType :: Stage -> GHCType -type family ExpressionType s = res | res -> s where - ExpressionType 'Parsed = ExpressionAtoms 'Parsed - ExpressionType 'Scoped = Expression - -type PatternAtomType :: Stage -> GHCType -type family PatternAtomType s = res | res -> s where - PatternAtomType 'Parsed = PatternAtom 'Parsed - PatternAtomType 'Scoped = PatternArg - -type PatternParensType :: Stage -> GHCType -type family PatternParensType s = res | res -> s where - PatternParensType 'Parsed = PatternAtoms 'Parsed - PatternParensType 'Scoped = PatternArg - -type PatternAtType :: Stage -> GHCType -type family PatternAtType s = res | res -> s where - PatternAtType 'Parsed = PatternBinding - PatternAtType 'Scoped = PatternArg - -type NameSignatureType :: Stage -> GHCType -type family NameSignatureType s = res | res -> s where - NameSignatureType 'Parsed = () - NameSignatureType 'Scoped = NameSignature 'Scoped - -type ModulePathType :: Stage -> ModuleIsTop -> GHCType -type family ModulePathType s t = res | res -> t s where - ModulePathType 'Parsed 'ModuleTop = TopModulePath - ModulePathType 'Scoped 'ModuleTop = S.TopModulePath - ModulePathType 'Parsed 'ModuleLocal = Symbol - ModulePathType 'Scoped 'ModuleLocal = S.Symbol - -type OpenModuleNameType :: Stage -> IsOpenShort -> GHCType -type family OpenModuleNameType s short = res where - OpenModuleNameType s 'OpenFull = ModuleNameType s - OpenModuleNameType _ 'OpenShort = () - -type ModuleNameType :: Stage -> GHCType -type family ModuleNameType s = res | res -> s where - ModuleNameType 'Parsed = Name - ModuleNameType 'Scoped = S.Name - -type ModuleInductiveType :: ModuleIsTop -> GHCType -type family ModuleInductiveType t = res | res -> t where - ModuleInductiveType 'ModuleTop = () - ModuleInductiveType 'ModuleLocal = LocalModuleOrigin - -type ModuleEndType :: ModuleIsTop -> GHCType -type family ModuleEndType t = res | res -> t where - ModuleEndType 'ModuleTop = () - ModuleEndType 'ModuleLocal = KeywordRef - --- | We keep the exact source of the pragma text. This is necessary, because --- pragmas are supposed to be backwards-compatible. Unrecognised pragmas --- should be ignored, but they still need to be printed out when --- pretty-printing. Also, we probably don't want to impose pragma formatting --- choices on the user. -type ParsedPragmas = WithLoc (WithSource Pragmas) - -data NameItem (s :: Stage) = NameItem - { _nameItemSymbol :: SymbolType s, - _nameItemIndex :: Int, - _nameItemType :: ExpressionType s, - _nameItemDefault :: Maybe (ArgDefault s) - } - deriving stock (Generic) - -instance Serialize (NameItem 'Scoped) - -instance NFData (NameItem 'Scoped) - -instance Serialize (NameItem 'Parsed) - -instance NFData (NameItem 'Parsed) - -data NameBlock (s :: Stage) = NameBlock - { -- | Symbols map to themselves so we can retrieve the location - -- | NOTE the index is wrt to the block, not the whole signature. - _nameBlock :: HashMap Symbol (NameItem s), - _nameImplicit :: IsImplicit - } - deriving stock (Generic) - -instance Serialize (NameBlock 'Scoped) - -instance NFData (NameBlock 'Scoped) - -instance Serialize (NameBlock 'Parsed) - -instance NFData (NameBlock 'Parsed) - --- | Two consecutive blocks should have different implicitness -newtype NameSignature (s :: Stage) = NameSignature - { _nameSignatureArgs :: [NameBlock s] - } - deriving stock (Generic) - -instance Serialize (NameSignature 'Scoped) - -instance NFData (NameSignature 'Scoped) - -instance Serialize (NameSignature 'Parsed) - -instance NFData (NameSignature 'Parsed) - -newtype RecordNameSignature s = RecordNameSignature - { _recordNames :: HashMap Symbol (NameItem s) - } - deriving stock (Generic) - -instance Serialize (RecordNameSignature 'Scoped) - -instance NFData (RecordNameSignature 'Scoped) - -instance Serialize (RecordNameSignature 'Parsed) - -instance NFData (RecordNameSignature 'Parsed) - -data RecordInfo = RecordInfo - { _recordInfoConstructor :: S.Symbol, - _recordInfoSignature :: RecordNameSignature 'Parsed - } - deriving stock (Generic) - -instance Serialize RecordInfo - -instance NFData RecordInfo - -data Argument (s :: Stage) - = ArgumentSymbol (SymbolType s) - | ArgumentWildcard Wildcard - deriving stock (Generic) - -instance Serialize (Argument 'Scoped) - -instance NFData (Argument 'Scoped) - -instance Serialize (Argument 'Parsed) - -instance NFData (Argument 'Parsed) - -deriving stock instance Show (Argument 'Parsed) - -deriving stock instance Show (Argument 'Scoped) - -deriving stock instance Eq (Argument 'Parsed) - -deriving stock instance Eq (Argument 'Scoped) - -deriving stock instance Ord (Argument 'Parsed) - -deriving stock instance Ord (Argument 'Scoped) - --- | We group consecutive definitions and reserve symbols in advance, so that we --- don't need extra syntax for mutually recursive definitions. Also, it allows --- us to be more flexible with the ordering of the definitions. -data StatementSections (s :: Stage) - = SectionsDefinitions (DefinitionsSection s) - | SectionsNonDefinitions (NonDefinitionsSection s) - | SectionsEmpty - -data DefinitionsSection (s :: Stage) = DefinitionsSection - { _definitionsSection :: NonEmpty (Definition s), - _definitionsNext :: Maybe (NonDefinitionsSection s) - } - -data NonDefinitionsSection (s :: Stage) = NonDefinitionsSection - { _nonDefinitionsSection :: NonEmpty (NonDefinition s), - _nonDefinitionsNext :: Maybe (DefinitionsSection s) - } - -data Definition (s :: Stage) - = DefinitionSyntax (SyntaxDef s) - | DefinitionFunctionDef (FunctionDef s) - | DefinitionInductive (InductiveDef s) - | DefinitionAxiom (AxiomDef s) - | DefinitionProjectionDef (ProjectionDef s) - -data NonDefinition (s :: Stage) - = NonDefinitionImport (Import s) - | NonDefinitionModule (Module s 'ModuleLocal) - | NonDefinitionOpenModule (OpenModule s 'OpenFull) - -data Statement (s :: Stage) - = StatementSyntax (SyntaxDef s) - | StatementFunctionDef (FunctionDef s) - | StatementImport (Import s) - | StatementInductive (InductiveDef s) - | StatementModule (Module s 'ModuleLocal) - | StatementOpenModule (OpenModule s 'OpenFull) - | StatementAxiom (AxiomDef s) - | StatementProjectionDef (ProjectionDef s) - -deriving stock instance Show (Statement 'Parsed) - -deriving stock instance Show (Statement 'Scoped) - -deriving stock instance Eq (Statement 'Parsed) - -deriving stock instance Eq (Statement 'Scoped) - -deriving stock instance Ord (Statement 'Parsed) - -deriving stock instance Ord (Statement 'Scoped) - -data ProjectionDef s = ProjectionDef - { _projectionConstructor :: S.Symbol, - _projectionField :: SymbolType s, - _projectionFieldIx :: Int, - _projectionFieldBuiltin :: Maybe (WithLoc BuiltinFunction), - _projectionDoc :: Maybe (Judoc s), - _projectionPragmas :: Maybe ParsedPragmas - } - -deriving stock instance Show (ProjectionDef 'Parsed) - -deriving stock instance Show (ProjectionDef 'Scoped) - -deriving stock instance Eq (ProjectionDef 'Parsed) - -deriving stock instance Eq (ProjectionDef 'Scoped) - -deriving stock instance Ord (ProjectionDef 'Parsed) - -deriving stock instance Ord (ProjectionDef 'Scoped) - -data Import (s :: Stage) = Import - { _importKw :: KeywordRef, - _importModulePath :: ModulePathType s 'ModuleTop, - _importAsName :: Maybe (ModulePathType s 'ModuleTop), - _importUsingHiding :: Maybe (UsingHiding s), - _importPublic :: PublicAnn, - _importOpen :: Maybe (OpenModule s 'OpenShort) - } - -deriving stock instance Show (Import 'Parsed) - -deriving stock instance Show (Import 'Scoped) - -deriving stock instance Eq (Import 'Parsed) - -deriving stock instance Eq (Import 'Scoped) - -deriving stock instance Ord (Import 'Parsed) - -deriving stock instance Ord (Import 'Scoped) - -data AliasDef (s :: Stage) = AliasDef - { _aliasDefSyntaxKw :: Irrelevant KeywordRef, - _aliasDefAliasKw :: Irrelevant KeywordRef, - _aliasDefName :: SymbolType s, - _aliasDefAsName :: IdentifierType s - } - deriving stock (Generic) - -instance Serialize (AliasDef 'Scoped) - -instance NFData (AliasDef 'Scoped) - -instance Serialize (AliasDef 'Parsed) - -instance NFData (AliasDef 'Parsed) - -deriving stock instance (Show (AliasDef 'Parsed)) - -deriving stock instance (Show (AliasDef 'Scoped)) - -deriving stock instance (Eq (AliasDef 'Parsed)) - -deriving stock instance (Eq (AliasDef 'Scoped)) - -deriving stock instance (Ord (AliasDef 'Parsed)) - -deriving stock instance (Ord (AliasDef 'Scoped)) - -data ParsedIteratorInfo = ParsedIteratorInfo - { _parsedIteratorInfoInitNum :: Maybe (WithLoc Int), - _parsedIteratorInfoRangeNum :: Maybe (WithLoc Int), - _parsedIteratorInfoBraces :: Irrelevant (KeywordRef, KeywordRef) - } - deriving stock (Show, Eq, Ord, Generic) - -data SyntaxDef (s :: Stage) - = SyntaxFixity (FixitySyntaxDef s) - | SyntaxOperator OperatorSyntaxDef - | SyntaxIterator IteratorSyntaxDef - | SyntaxAlias (AliasDef s) - -deriving stock instance (Show (SyntaxDef 'Parsed)) - -deriving stock instance (Show (SyntaxDef 'Scoped)) - -deriving stock instance (Eq (SyntaxDef 'Parsed)) - -deriving stock instance (Eq (SyntaxDef 'Scoped)) - -deriving stock instance (Ord (SyntaxDef 'Parsed)) - -deriving stock instance (Ord (SyntaxDef 'Scoped)) - -data ParsedFixityFields (s :: Stage) = ParsedFixityFields - { _fixityFieldsAssoc :: Maybe BinaryAssoc, - _fixityFieldsPrecSame :: Maybe (SymbolType s), - _fixityFieldsPrecBelow :: Maybe [SymbolType s], - _fixityFieldsPrecAbove :: Maybe [SymbolType s], - _fixityFieldsBraces :: Irrelevant (KeywordRef, KeywordRef) - } - -deriving stock instance (Show (ParsedFixityFields 'Parsed)) - -deriving stock instance (Show (ParsedFixityFields 'Scoped)) - -deriving stock instance (Eq (ParsedFixityFields 'Parsed)) - -deriving stock instance (Eq (ParsedFixityFields 'Scoped)) - -deriving stock instance (Ord (ParsedFixityFields 'Parsed)) - -deriving stock instance (Ord (ParsedFixityFields 'Scoped)) - -data ParsedFixityInfo (s :: Stage) = ParsedFixityInfo - { _fixityParsedArity :: WithLoc Arity, - _fixityFields :: Maybe (ParsedFixityFields s) - } - -deriving stock instance (Show (ParsedFixityInfo 'Parsed)) - -deriving stock instance (Show (ParsedFixityInfo 'Scoped)) - -deriving stock instance (Eq (ParsedFixityInfo 'Parsed)) - -deriving stock instance (Eq (ParsedFixityInfo 'Scoped)) - -deriving stock instance (Ord (ParsedFixityInfo 'Parsed)) - -deriving stock instance (Ord (ParsedFixityInfo 'Scoped)) - -data FixitySyntaxDef (s :: Stage) = FixitySyntaxDef - { _fixitySymbol :: SymbolType s, - _fixityDoc :: Maybe (Judoc s), - _fixityInfo :: ParsedFixityInfo s, - _fixityKw :: KeywordRef, - _fixityAssignKw :: KeywordRef, - _fixitySyntaxKw :: KeywordRef - } - -deriving stock instance (Show (FixitySyntaxDef 'Parsed)) - -deriving stock instance (Show (FixitySyntaxDef 'Scoped)) - -deriving stock instance (Eq (FixitySyntaxDef 'Parsed)) - -deriving stock instance (Eq (FixitySyntaxDef 'Scoped)) - -deriving stock instance (Ord (FixitySyntaxDef 'Parsed)) - -deriving stock instance (Ord (FixitySyntaxDef 'Scoped)) - -data FixityDef = FixityDef - { _fixityDefSymbol :: S.Symbol, - _fixityDefFixity :: Fixity, - -- | Used internally for printing parentheses. - _fixityDefPrec :: Int - } - deriving stock (Show, Eq, Ord, Generic) - -instance Serialize FixityDef - -instance NFData FixityDef - -data OperatorSyntaxDef = OperatorSyntaxDef - { _opSymbol :: Symbol, - _opFixity :: Symbol, - _opKw :: KeywordRef, - _opSyntaxKw :: KeywordRef - } - deriving stock (Show, Eq, Ord, Generic) - -instance Serialize OperatorSyntaxDef - -instance NFData OperatorSyntaxDef - -instance HasLoc OperatorSyntaxDef where - getLoc OperatorSyntaxDef {..} = getLoc _opSyntaxKw <> getLoc _opSymbol - -data IteratorSyntaxDef = IteratorSyntaxDef - { _iterSymbol :: Symbol, - _iterInfo :: Maybe ParsedIteratorInfo, - _iterSyntaxKw :: KeywordRef, - _iterIteratorKw :: KeywordRef - } - deriving stock (Show, Eq, Ord) - -instance HasLoc IteratorSyntaxDef where - getLoc IteratorSyntaxDef {..} = getLoc _iterSyntaxKw <> getLoc _iterSymbol - -data ArgDefault (s :: Stage) = ArgDefault - { _argDefaultAssign :: Irrelevant KeywordRef, - _argDefaultValue :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (ArgDefault 'Scoped) - -instance NFData (ArgDefault 'Scoped) - -instance Serialize (ArgDefault 'Parsed) - -instance NFData (ArgDefault 'Parsed) - -deriving stock instance Show (ArgDefault 'Parsed) - -deriving stock instance Show (ArgDefault 'Scoped) - -deriving stock instance Eq (ArgDefault 'Parsed) - -deriving stock instance Eq (ArgDefault 'Scoped) - -deriving stock instance Ord (ArgDefault 'Parsed) - -deriving stock instance Ord (ArgDefault 'Scoped) - -data SigArg (s :: Stage) = SigArg - { _sigArgDelims :: Irrelevant (KeywordRef, KeywordRef), - _sigArgImplicit :: IsImplicit, - -- | Allowed to be empty only for Instance arguments - _sigArgNames :: [Argument s], - _sigArgColon :: Maybe (Irrelevant KeywordRef), - -- | The type is only optional for implicit arguments. Omitting the rhs is - -- equivalent to writing `: Type`. - _sigArgType :: Maybe (ExpressionType s), - _sigArgDefault :: Maybe (ArgDefault s) - } - deriving stock (Generic) - -instance Serialize (SigArg 'Scoped) - -instance NFData (SigArg 'Scoped) - -instance Serialize (SigArg 'Parsed) - -instance NFData (SigArg 'Parsed) - -deriving stock instance Show (SigArg 'Parsed) - -deriving stock instance Show (SigArg 'Scoped) - -deriving stock instance Eq (SigArg 'Parsed) - -deriving stock instance Eq (SigArg 'Scoped) - -deriving stock instance Ord (SigArg 'Parsed) - -deriving stock instance Ord (SigArg 'Scoped) - -data FunctionClause (s :: Stage) = FunctionClause - { _clausenPipeKw :: Irrelevant KeywordRef, - _clausenPatterns :: NonEmpty (PatternAtomType s), - _clausenAssignKw :: Irrelevant KeywordRef, - _clausenBody :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (FunctionClause 'Scoped) - -instance NFData (FunctionClause 'Scoped) - -instance Serialize (FunctionClause 'Parsed) - -instance NFData (FunctionClause 'Parsed) - -deriving stock instance Show (FunctionClause 'Parsed) - -deriving stock instance Show (FunctionClause 'Scoped) - -deriving stock instance Eq (FunctionClause 'Parsed) - -deriving stock instance Eq (FunctionClause 'Scoped) - -deriving stock instance Ord (FunctionClause 'Parsed) - -deriving stock instance Ord (FunctionClause 'Scoped) - -data FunctionDefBody (s :: Stage) - = SigBodyExpression (ExpressionType s) - | SigBodyClauses (NonEmpty (FunctionClause s)) - deriving stock (Generic) - -instance Serialize (FunctionDefBody 'Scoped) - -instance NFData (FunctionDefBody 'Scoped) - -instance Serialize (FunctionDefBody 'Parsed) - -instance NFData (FunctionDefBody 'Parsed) - -deriving stock instance Show (FunctionDefBody 'Parsed) - -deriving stock instance Show (FunctionDefBody 'Scoped) - -deriving stock instance Eq (FunctionDefBody 'Parsed) - -deriving stock instance Eq (FunctionDefBody 'Scoped) - -deriving stock instance Ord (FunctionDefBody 'Parsed) - -deriving stock instance Ord (FunctionDefBody 'Scoped) - -data FunctionDef (s :: Stage) = FunctionDef - { _signName :: FunctionName s, - _signArgs :: [SigArg s], - _signColonKw :: Irrelevant (Maybe KeywordRef), - _signRetType :: Maybe (ExpressionType s), - _signDoc :: Maybe (Judoc s), - _signPragmas :: Maybe ParsedPragmas, - _signBuiltin :: Maybe (WithLoc BuiltinFunction), - _signBody :: FunctionDefBody s, - _signTerminating :: Maybe KeywordRef, - _signInstance :: Maybe KeywordRef, - _signCoercion :: Maybe KeywordRef - } - deriving stock (Generic) - -instance Serialize (FunctionDef 'Scoped) - -instance NFData (FunctionDef 'Scoped) - -instance Serialize (FunctionDef 'Parsed) - -instance NFData (FunctionDef 'Parsed) - -deriving stock instance Show (FunctionDef 'Parsed) - -deriving stock instance Show (FunctionDef 'Scoped) - -deriving stock instance Eq (FunctionDef 'Parsed) - -deriving stock instance Eq (FunctionDef 'Scoped) - -deriving stock instance Ord (FunctionDef 'Parsed) - -deriving stock instance Ord (FunctionDef 'Scoped) - -data AxiomDef (s :: Stage) = AxiomDef - { _axiomKw :: Irrelevant KeywordRef, - _axiomDoc :: Maybe (Judoc s), - _axiomPragmas :: Maybe ParsedPragmas, - _axiomName :: SymbolType s, - _axiomColonKw :: Irrelevant KeywordRef, - _axiomBuiltin :: Maybe (WithLoc BuiltinAxiom), - _axiomType :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (AxiomDef 'Scoped) - -instance NFData (AxiomDef 'Scoped) - -deriving stock instance Show (AxiomDef 'Parsed) - -deriving stock instance Show (AxiomDef 'Scoped) - -deriving stock instance Eq (AxiomDef 'Parsed) - -deriving stock instance Eq (AxiomDef 'Scoped) - -deriving stock instance Ord (AxiomDef 'Parsed) - -deriving stock instance Ord (AxiomDef 'Scoped) - -type InductiveConstructorName s = SymbolType s - -type InductiveName s = SymbolType s - -data ConstructorDef (s :: Stage) = ConstructorDef - { _constructorPipe :: Irrelevant (Maybe KeywordRef), - _constructorName :: InductiveConstructorName s, - _constructorInductiveName :: InductiveName s, - _constructorDoc :: Maybe (Judoc s), - _constructorPragmas :: Maybe ParsedPragmas, - _constructorRhs :: ConstructorRhs s - } - deriving stock (Generic) - -instance Serialize (ConstructorDef 'Scoped) - -instance NFData (ConstructorDef 'Scoped) - -deriving stock instance Show (ConstructorDef 'Parsed) - -deriving stock instance Show (ConstructorDef 'Scoped) - -deriving stock instance Eq (ConstructorDef 'Parsed) - -deriving stock instance Eq (ConstructorDef 'Scoped) - -deriving stock instance Ord (ConstructorDef 'Parsed) - -deriving stock instance Ord (ConstructorDef 'Scoped) - -data RecordUpdateField (s :: Stage) = RecordUpdateField - { _fieldUpdateName :: Symbol, - _fieldUpdateArgIx :: FieldArgIxType s, - _fieldUpdateAssignKw :: Irrelevant (KeywordRef), - _fieldUpdateValue :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (RecordUpdateField 'Scoped) - -instance NFData (RecordUpdateField 'Scoped) - -instance Serialize (RecordUpdateField 'Parsed) - -instance NFData (RecordUpdateField 'Parsed) - -deriving stock instance Show (RecordUpdateField 'Parsed) - -deriving stock instance Show (RecordUpdateField 'Scoped) - -deriving stock instance Eq (RecordUpdateField 'Parsed) - -deriving stock instance Eq (RecordUpdateField 'Scoped) - -deriving stock instance Ord (RecordUpdateField 'Parsed) - -deriving stock instance Ord (RecordUpdateField 'Scoped) - -data RecordField (s :: Stage) = RecordField - { _fieldName :: SymbolType s, - _fieldColon :: Irrelevant (KeywordRef), - _fieldType :: ExpressionType s, - _fieldBuiltin :: Maybe (WithLoc BuiltinFunction), - _fieldDoc :: Maybe (Judoc s), - _fieldPragmas :: Maybe ParsedPragmas - } - deriving stock (Generic) - -instance Serialize (RecordField 'Scoped) - -instance NFData (RecordField 'Scoped) - -deriving stock instance Show (RecordField 'Parsed) - -deriving stock instance Show (RecordField 'Scoped) - -deriving stock instance Eq (RecordField 'Parsed) - -deriving stock instance Eq (RecordField 'Scoped) - -deriving stock instance Ord (RecordField 'Parsed) - -deriving stock instance Ord (RecordField 'Scoped) - -newtype RhsAdt (s :: Stage) = RhsAdt - { _rhsAdtArguments :: [ExpressionType s] - } - deriving stock (Generic) - -instance Serialize (RhsAdt 'Scoped) - -instance NFData (RhsAdt 'Scoped) - -deriving stock instance Show (RhsAdt 'Parsed) - -deriving stock instance Show (RhsAdt 'Scoped) - -deriving stock instance Eq (RhsAdt 'Parsed) - -deriving stock instance Eq (RhsAdt 'Scoped) - -deriving stock instance Ord (RhsAdt 'Parsed) - -deriving stock instance Ord (RhsAdt 'Scoped) - -data RhsRecord (s :: Stage) = RhsRecord - { _rhsRecordDelim :: Irrelevant (KeywordRef, KeywordRef), - _rhsRecordStatements :: [RecordStatement s] - } - deriving stock (Generic) - -instance Serialize (RhsRecord 'Scoped) - -instance NFData (RhsRecord 'Scoped) - -deriving stock instance Show (RhsRecord 'Parsed) - -deriving stock instance Show (RhsRecord 'Scoped) - -deriving stock instance Eq (RhsRecord 'Parsed) - -deriving stock instance Eq (RhsRecord 'Scoped) - -deriving stock instance Ord (RhsRecord 'Parsed) - -deriving stock instance Ord (RhsRecord 'Scoped) - -data RhsGadt (s :: Stage) = RhsGadt - { _rhsGadtColon :: Irrelevant KeywordRef, - _rhsGadtType :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (RhsGadt 'Scoped) - -instance NFData (RhsGadt 'Scoped) - -deriving stock instance Show (RhsGadt 'Parsed) - -deriving stock instance Show (RhsGadt 'Scoped) - -deriving stock instance Eq (RhsGadt 'Parsed) - -deriving stock instance Eq (RhsGadt 'Scoped) - -deriving stock instance Ord (RhsGadt 'Parsed) - -deriving stock instance Ord (RhsGadt 'Scoped) - -data ConstructorRhs (s :: Stage) - = ConstructorRhsGadt (RhsGadt s) - | ConstructorRhsRecord (RhsRecord s) - | ConstructorRhsAdt (RhsAdt s) - deriving stock (Generic) - -instance Serialize (ConstructorRhs 'Scoped) - -instance NFData (ConstructorRhs 'Scoped) - -deriving stock instance Show (ConstructorRhs 'Parsed) - -deriving stock instance Show (ConstructorRhs 'Scoped) - -deriving stock instance Eq (ConstructorRhs 'Parsed) - -deriving stock instance Eq (ConstructorRhs 'Scoped) - -deriving stock instance Ord (ConstructorRhs 'Parsed) - -deriving stock instance Ord (ConstructorRhs 'Scoped) - -data InductiveParametersRhs (s :: Stage) = InductiveParametersRhs - { _inductiveParametersColon :: Irrelevant KeywordRef, - _inductiveParametersType :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (InductiveParametersRhs 'Scoped) - -instance NFData (InductiveParametersRhs 'Scoped) - -deriving stock instance Show (InductiveParametersRhs 'Parsed) - -deriving stock instance Show (InductiveParametersRhs 'Scoped) - -deriving stock instance Eq (InductiveParametersRhs 'Parsed) - -deriving stock instance Eq (InductiveParametersRhs 'Scoped) - -deriving stock instance Ord (InductiveParametersRhs 'Parsed) - -deriving stock instance Ord (InductiveParametersRhs 'Scoped) - -data InductiveParameters (s :: Stage) = InductiveParameters - { _inductiveParametersNames :: NonEmpty (SymbolType s), - _inductiveParametersRhs :: Maybe (InductiveParametersRhs s) - } - deriving stock (Generic) - -instance Serialize (InductiveParameters 'Scoped) - -instance NFData (InductiveParameters 'Scoped) - -deriving stock instance Show (InductiveParameters 'Parsed) - -deriving stock instance Show (InductiveParameters 'Scoped) - -deriving stock instance Eq (InductiveParameters 'Parsed) - -deriving stock instance Eq (InductiveParameters 'Scoped) - -deriving stock instance Ord (InductiveParameters 'Parsed) - -deriving stock instance Ord (InductiveParameters 'Scoped) - -data InductiveDef (s :: Stage) = InductiveDef - { _inductiveKw :: Irrelevant KeywordRef, - _inductiveAssignKw :: Irrelevant KeywordRef, - _inductiveBuiltin :: Maybe (WithLoc BuiltinInductive), - _inductiveDoc :: Maybe (Judoc s), - _inductivePragmas :: Maybe ParsedPragmas, - _inductiveName :: InductiveName s, - _inductiveParameters :: [InductiveParameters s], - _inductiveType :: Maybe (ExpressionType s), - _inductiveConstructors :: NonEmpty (ConstructorDef s), - _inductivePositive :: Maybe KeywordRef, - _inductiveTrait :: Maybe KeywordRef - } - deriving stock (Generic) - -instance Serialize (InductiveDef 'Scoped) - -instance NFData (InductiveDef 'Scoped) - -deriving stock instance Show (InductiveDef 'Parsed) - -deriving stock instance Show (InductiveDef 'Scoped) - -deriving stock instance Eq (InductiveDef 'Parsed) - -deriving stock instance Eq (InductiveDef 'Scoped) - -deriving stock instance Ord (InductiveDef 'Parsed) - -deriving stock instance Ord (InductiveDef 'Scoped) - -data PatternApp = PatternApp - { _patAppLeft :: PatternArg, - _patAppRight :: PatternArg - } - deriving stock (Show, Eq, Ord, Generic) - -instance Serialize PatternApp - -instance NFData PatternApp - -data PatternInfixApp = PatternInfixApp - { _patInfixLeft :: PatternArg, - _patInfixConstructor :: ScopedIden, - _patInfixRight :: PatternArg - } - deriving stock (Show, Eq, Ord, Generic) - -instance Serialize PatternInfixApp - -instance NFData PatternInfixApp - -data PatternPostfixApp = PatternPostfixApp - { _patPostfixParameter :: PatternArg, - _patPostfixConstructor :: ScopedIden - } - deriving stock (Show, Eq, Ord, Generic) - -instance Serialize PatternPostfixApp - -instance NFData PatternPostfixApp - -data PatternArg = PatternArg - { _patternArgIsImplicit :: IsImplicit, - _patternArgName :: Maybe S.Symbol, - _patternArgPattern :: Pattern - } - deriving stock (Show, Eq, Ord, Generic) - -instance Serialize PatternArg - -instance NFData PatternArg - -data Pattern - = PatternVariable (SymbolType 'Scoped) - | PatternConstructor ScopedIden - | PatternWildcardConstructor (WildcardConstructor 'Scoped) - | PatternApplication PatternApp - | PatternList (ListPattern 'Scoped) - | PatternInfixApplication PatternInfixApp - | PatternPostfixApplication PatternPostfixApp - | PatternWildcard Wildcard - | PatternEmpty Interval - | PatternRecord (RecordPattern 'Scoped) - deriving stock (Show, Eq, Ord, Generic) - -instance Serialize Pattern - -instance NFData Pattern - -data PatternScopedIden - = PatternScopedVar S.Symbol - | PatternScopedConstructor ScopedIden - deriving stock (Show, Ord, Eq) - -data PatternBinding = PatternBinding - { _patternBindingName :: Symbol, - _patternBindingAtKw :: Irrelevant KeywordRef, - _patternBindingPattern :: PatternAtom 'Parsed - } - deriving stock (Ord, Eq, Show, Generic) - -instance Serialize PatternBinding - -instance NFData PatternBinding - -data ListPattern (s :: Stage) = ListPattern - { _listpBracketL :: Irrelevant KeywordRef, - _listpBracketR :: Irrelevant KeywordRef, - _listpItems :: [PatternParensType s] - } - deriving stock (Generic) - -instance Serialize (ListPattern 'Scoped) - -instance NFData (ListPattern 'Scoped) - -instance Serialize (ListPattern 'Parsed) - -instance NFData (ListPattern 'Parsed) - -deriving stock instance Show (ListPattern 'Parsed) - -deriving stock instance Show (ListPattern 'Scoped) - -deriving stock instance Eq (ListPattern 'Parsed) - -deriving stock instance Eq (ListPattern 'Scoped) - -deriving stock instance Ord (ListPattern 'Parsed) - -deriving stock instance Ord (ListPattern 'Scoped) - -data RecordPatternAssign (s :: Stage) = RecordPatternAssign - { _recordPatternAssignKw :: Irrelevant KeywordRef, - _recordPatternAssignField :: Symbol, - _recordPatternAssignFieldIx :: FieldArgIxType s, - _recordPatternAssignPattern :: PatternParensType s - } - deriving stock (Generic) - -instance Serialize (RecordPatternAssign 'Scoped) - -instance NFData (RecordPatternAssign 'Scoped) - -instance Serialize (RecordPatternAssign 'Parsed) - -instance NFData (RecordPatternAssign 'Parsed) - -deriving stock instance Show (RecordPatternAssign 'Parsed) - -deriving stock instance Show (RecordPatternAssign 'Scoped) - -deriving stock instance Eq (RecordPatternAssign 'Parsed) - -deriving stock instance Eq (RecordPatternAssign 'Scoped) - -deriving stock instance Ord (RecordPatternAssign 'Parsed) - -deriving stock instance Ord (RecordPatternAssign 'Scoped) - -data FieldPun (s :: Stage) = FieldPun - { _fieldPunIx :: FieldArgIxType s, - _fieldPunField :: SymbolType s - } - deriving stock (Generic) - -instance Serialize (FieldPun 'Scoped) - -instance NFData (FieldPun 'Scoped) - -instance Serialize (FieldPun 'Parsed) - -instance NFData (FieldPun 'Parsed) - -deriving stock instance Show (FieldPun 'Parsed) - -deriving stock instance Show (FieldPun 'Scoped) - -deriving stock instance Eq (FieldPun 'Parsed) - -deriving stock instance Eq (FieldPun 'Scoped) - -deriving stock instance Ord (FieldPun 'Parsed) - -deriving stock instance Ord (FieldPun 'Scoped) - -data RecordPatternItem (s :: Stage) - = RecordPatternItemFieldPun (FieldPun s) - | RecordPatternItemAssign (RecordPatternAssign s) - deriving stock (Generic) - -instance Serialize (RecordPatternItem 'Scoped) - -instance NFData (RecordPatternItem 'Scoped) - -instance Serialize (RecordPatternItem 'Parsed) - -instance NFData (RecordPatternItem 'Parsed) - -deriving stock instance Show (RecordPatternItem 'Parsed) - -deriving stock instance Show (RecordPatternItem 'Scoped) - -deriving stock instance Eq (RecordPatternItem 'Parsed) - -deriving stock instance Eq (RecordPatternItem 'Scoped) - -deriving stock instance Ord (RecordPatternItem 'Parsed) - -deriving stock instance Ord (RecordPatternItem 'Scoped) - -data RecordPattern (s :: Stage) = RecordPattern - { _recordPatternConstructor :: IdentifierType s, - _recordPatternItems :: [RecordPatternItem s] - } - deriving stock (Generic) - -instance Serialize (RecordPattern 'Scoped) - -instance NFData (RecordPattern 'Scoped) - -instance Serialize (RecordPattern 'Parsed) - -instance NFData (RecordPattern 'Parsed) - -deriving stock instance Show (RecordPattern 'Parsed) - -deriving stock instance Show (RecordPattern 'Scoped) - -deriving stock instance Eq (RecordPattern 'Parsed) - -deriving stock instance Eq (RecordPattern 'Scoped) - -deriving stock instance Ord (RecordPattern 'Parsed) - -deriving stock instance Ord (RecordPattern 'Scoped) - -data WildcardConstructor (s :: Stage) = WildcardConstructor - { _wildcardConstructor :: IdentifierType s, - _wildcardConstructorAtKw :: Irrelevant KeywordRef, - _wildcardConstructorDelims :: Irrelevant (KeywordRef, KeywordRef) - } - deriving stock (Generic) - -instance Serialize (WildcardConstructor 'Scoped) - -instance NFData (WildcardConstructor 'Scoped) - -instance Serialize (WildcardConstructor 'Parsed) - -instance NFData (WildcardConstructor 'Parsed) - -deriving stock instance Show (WildcardConstructor 'Parsed) - -deriving stock instance Show (WildcardConstructor 'Scoped) - -deriving stock instance Eq (WildcardConstructor 'Parsed) - -deriving stock instance Eq (WildcardConstructor 'Scoped) - -deriving stock instance Ord (WildcardConstructor 'Parsed) - -deriving stock instance Ord (WildcardConstructor 'Scoped) - -data PatternAtom (s :: Stage) - = PatternAtomIden (PatternAtomIdenType s) - | PatternAtomWildcard Wildcard - | PatternAtomEmpty Interval - | PatternAtomList (ListPattern s) - | PatternAtomWildcardConstructor (WildcardConstructor s) - | PatternAtomRecord (RecordPattern s) - | PatternAtomParens (PatternParensType s) - | PatternAtomBraces (PatternParensType s) - | PatternAtomDoubleBraces (PatternParensType s) - | PatternAtomAt (PatternAtType s) - deriving stock (Generic) - -instance Serialize (PatternAtom 'Parsed) - -instance NFData (PatternAtom 'Parsed) - -deriving stock instance Show (PatternAtom 'Parsed) - -deriving stock instance Show (PatternAtom 'Scoped) - -deriving stock instance Eq (PatternAtom 'Parsed) - -deriving stock instance Eq (PatternAtom 'Scoped) - -deriving stock instance Ord (PatternAtom 'Parsed) - -deriving stock instance Ord (PatternAtom 'Scoped) - -data PatternAtoms (s :: Stage) = PatternAtoms - { _patternAtoms :: NonEmpty (PatternAtom s), - _patternAtomsLoc :: Irrelevant Interval - } - deriving stock (Generic) - -instance Serialize (PatternAtoms 'Parsed) - -instance NFData (PatternAtoms 'Parsed) - -deriving stock instance Show (PatternAtoms 'Parsed) - -deriving stock instance Show (PatternAtoms 'Scoped) - -deriving stock instance Eq (PatternAtoms 'Parsed) - -deriving stock instance Eq (PatternAtoms 'Scoped) - -deriving stock instance Ord (PatternAtoms 'Parsed) - -deriving stock instance Ord (PatternAtoms 'Scoped) - -type FunctionName s = SymbolType s - -type LocalModuleName s = SymbolType s - -data MarkdownInfo = MarkdownInfo - { _markdownInfo :: Mk, - _markdownInfoBlockLengths :: [Int] - } - deriving stock (Show, Eq, Ord) - -data Module (s :: Stage) (t :: ModuleIsTop) = Module - { _moduleKw :: KeywordRef, - _modulePath :: ModulePathType s t, - _moduleDoc :: Maybe (Judoc s), - _modulePragmas :: Maybe ParsedPragmas, - _moduleBody :: [Statement s], - _moduleKwEnd :: ModuleEndType t, - _moduleOrigin :: ModuleInductiveType t, - _moduleId :: ModuleIdType s t, - _moduleMarkdownInfo :: Maybe MarkdownInfo - } - -deriving stock instance Show (Module 'Parsed 'ModuleTop) - -deriving stock instance Show (Module 'Scoped 'ModuleTop) - -deriving stock instance Show (Module 'Parsed 'ModuleLocal) - -deriving stock instance Show (Module 'Scoped 'ModuleLocal) - -deriving stock instance Eq (Module 'Parsed 'ModuleTop) - -deriving stock instance Eq (Module 'Scoped 'ModuleTop) - -deriving stock instance Eq (Module 'Parsed 'ModuleLocal) - -deriving stock instance Eq (Module 'Scoped 'ModuleLocal) - -deriving stock instance Ord (Module 'Parsed 'ModuleTop) - -deriving stock instance Ord (Module 'Scoped 'ModuleTop) - -deriving stock instance Ord (Module 'Parsed 'ModuleLocal) - -deriving stock instance Ord (Module 'Scoped 'ModuleLocal) - -data HidingItem (s :: Stage) = HidingItem - { _hidingSymbol :: SymbolType s, - _hidingModuleKw :: Maybe KeywordRef - } - deriving stock (Generic) - -instance Serialize (HidingItem 'Scoped) - -instance NFData (HidingItem 'Scoped) - -instance Serialize (HidingItem 'Parsed) - -instance NFData (HidingItem 'Parsed) - -deriving stock instance Show (HidingItem 'Parsed) - -deriving stock instance Show (HidingItem 'Scoped) - -deriving stock instance Eq (HidingItem 'Parsed) - -deriving stock instance Eq (HidingItem 'Scoped) - -deriving stock instance Ord (HidingItem 'Parsed) - -deriving stock instance Ord (HidingItem 'Scoped) - -data UsingItem (s :: Stage) = UsingItem - { _usingSymbol :: SymbolType s, - _usingModuleKw :: Maybe KeywordRef, - _usingAsKw :: Irrelevant (Maybe KeywordRef), - _usingAs :: Maybe (SymbolType s) - } - deriving stock (Generic) - -instance Serialize (UsingItem 'Scoped) - -instance NFData (UsingItem 'Scoped) - -instance Serialize (UsingItem 'Parsed) - -instance NFData (UsingItem 'Parsed) - -deriving stock instance Show (UsingItem 'Parsed) - -deriving stock instance Show (UsingItem 'Scoped) - -deriving stock instance Eq (UsingItem 'Parsed) - -deriving stock instance Eq (UsingItem 'Scoped) - -deriving stock instance Ord (UsingItem 'Parsed) - -deriving stock instance Ord (UsingItem 'Scoped) - -data UsingList (s :: Stage) = UsingList - { _usingKw :: Irrelevant KeywordRef, - _usingBraces :: Irrelevant (KeywordRef, KeywordRef), - _usingList :: NonEmpty (UsingItem s) - } - deriving stock (Generic) - -instance Serialize (UsingList 'Scoped) - -instance NFData (UsingList 'Scoped) - -instance Serialize (UsingList 'Parsed) - -instance NFData (UsingList 'Parsed) - -deriving stock instance Show (UsingList 'Parsed) - -deriving stock instance Show (UsingList 'Scoped) - -deriving stock instance Eq (UsingList 'Parsed) - -deriving stock instance Eq (UsingList 'Scoped) - -deriving stock instance Ord (UsingList 'Parsed) - -deriving stock instance Ord (UsingList 'Scoped) - -data HidingList (s :: Stage) = HidingList - { _hidingKw :: Irrelevant KeywordRef, - _hidingBraces :: Irrelevant (KeywordRef, KeywordRef), - _hidingList :: NonEmpty (HidingItem s) - } - deriving stock (Generic) - -instance Serialize (HidingList 'Scoped) - -instance NFData (HidingList 'Scoped) - -instance Serialize (HidingList 'Parsed) - -instance NFData (HidingList 'Parsed) - -deriving stock instance Show (HidingList 'Parsed) - -deriving stock instance Show (HidingList 'Scoped) - -deriving stock instance Eq (HidingList 'Parsed) - -deriving stock instance Eq (HidingList 'Scoped) - -deriving stock instance Ord (HidingList 'Parsed) - -deriving stock instance Ord (HidingList 'Scoped) - -data UsingHiding (s :: Stage) - = Using (UsingList s) - | Hiding (HidingList s) - deriving stock (Generic) - -instance Serialize (UsingHiding 'Scoped) - -instance NFData (UsingHiding 'Scoped) - -instance Serialize (UsingHiding 'Parsed) - -instance NFData (UsingHiding 'Parsed) - -deriving stock instance Show (UsingHiding 'Parsed) - -deriving stock instance Show (UsingHiding 'Scoped) - -deriving stock instance Eq (UsingHiding 'Parsed) - -deriving stock instance Eq (UsingHiding 'Scoped) - -deriving stock instance Ord (UsingHiding 'Parsed) - -deriving stock instance Ord (UsingHiding 'Scoped) - -getNameRefId :: forall c. (SingI c) => RefNameType c -> S.NameId -getNameRefId = case sing :: S.SIsConcrete c of - S.SConcrete -> (^. S.nameId) - S.SNotConcrete -> (^. S.nameId) - -data OpenModule (s :: Stage) (short :: IsOpenShort) = OpenModule - { _openModuleKw :: KeywordRef, - _openModuleName :: OpenModuleNameType s short, - _openModuleUsingHiding :: Maybe (UsingHiding s), - _openModulePublic :: PublicAnn - } - deriving stock (Generic) - -instance Serialize (OpenModule 'Scoped 'OpenFull) - -instance Serialize (OpenModule 'Scoped 'OpenShort) - -instance NFData (OpenModule 'Scoped 'OpenFull) - -instance NFData (OpenModule 'Scoped 'OpenShort) - -instance Serialize (OpenModule 'Parsed 'OpenFull) - -instance Serialize (OpenModule 'Parsed 'OpenShort) - -instance NFData (OpenModule 'Parsed 'OpenShort) - -instance NFData (OpenModule 'Parsed 'OpenFull) - -deriving stock instance Show (OpenModule 'Parsed 'OpenShort) - -deriving stock instance Show (OpenModule 'Parsed 'OpenFull) - -deriving stock instance Show (OpenModule 'Scoped 'OpenShort) - -deriving stock instance Show (OpenModule 'Scoped 'OpenFull) - -deriving stock instance Eq (OpenModule 'Parsed 'OpenShort) - -deriving stock instance Eq (OpenModule 'Parsed 'OpenFull) - -deriving stock instance Eq (OpenModule 'Scoped 'OpenShort) - -deriving stock instance Eq (OpenModule 'Scoped 'OpenFull) - -deriving stock instance Ord (OpenModule 'Parsed 'OpenShort) - -deriving stock instance Ord (OpenModule 'Parsed 'OpenFull) - -deriving stock instance Ord (OpenModule 'Scoped 'OpenShort) - -deriving stock instance Ord (OpenModule 'Scoped 'OpenFull) - -data ScopedIden = ScopedIden - { _scopedIdenFinal :: S.Name, - _scopedIdenAlias :: Maybe S.Name - } - deriving stock (Show, Eq, Ord, Generic) - -instance Serialize ScopedIden - -instance NFData ScopedIden - -data Expression - = ExpressionIdentifier ScopedIden - | ExpressionParensIdentifier ScopedIden - | ExpressionApplication Application - | ExpressionInfixApplication InfixApplication - | ExpressionPostfixApplication PostfixApplication - | ExpressionList (List 'Scoped) - | ExpressionCase (Case 'Scoped) - | ExpressionIf (If 'Scoped) - | ExpressionLambda (Lambda 'Scoped) - | ExpressionLet (Let 'Scoped) - | ExpressionUniverse Universe - | ExpressionLiteral LiteralLoc - | ExpressionFunction (Function 'Scoped) - | ExpressionHole (HoleType 'Scoped) - | ExpressionInstanceHole (HoleType 'Scoped) - | ExpressionRecordUpdate RecordUpdateApp - | ExpressionParensRecordUpdate ParensRecordUpdate - | ExpressionBraces (WithLoc Expression) - | ExpressionDoubleBraces (DoubleBracesExpression 'Scoped) - | ExpressionIterator (Iterator 'Scoped) - | ExpressionNamedApplication (NamedApplication 'Scoped) - | ExpressionNamedApplicationNew (NamedApplicationNew 'Scoped) - deriving stock (Show, Eq, Ord, Generic) - -instance Serialize Expression - -instance NFData Expression - -data DoubleBracesExpression (s :: Stage) = DoubleBracesExpression - { _doubleBracesExpression :: ExpressionType s, - _doubleBracesDelims :: Irrelevant (KeywordRef, KeywordRef) - } - deriving stock (Generic) - -instance Serialize (DoubleBracesExpression 'Scoped) - -instance NFData (DoubleBracesExpression 'Scoped) - -instance Serialize (DoubleBracesExpression 'Parsed) - -instance NFData (DoubleBracesExpression 'Parsed) - -deriving stock instance Show (DoubleBracesExpression 'Parsed) - -deriving stock instance Show (DoubleBracesExpression 'Scoped) - -deriving stock instance Eq (DoubleBracesExpression 'Parsed) - -deriving stock instance Eq (DoubleBracesExpression 'Scoped) - -deriving stock instance Ord (DoubleBracesExpression 'Parsed) - -deriving stock instance Ord (DoubleBracesExpression 'Scoped) - -instance HasAtomicity (Lambda s) where - atomicity = const Atom - -data FunctionParameter (s :: Stage) - = FunctionParameterName (SymbolType s) - | FunctionParameterWildcard KeywordRef - deriving stock (Generic) - -instance Serialize (FunctionParameter 'Scoped) - -instance NFData (FunctionParameter 'Scoped) - -instance Serialize (FunctionParameter 'Parsed) - -instance NFData (FunctionParameter 'Parsed) - -deriving stock instance Show (FunctionParameter 'Parsed) - -deriving stock instance Show (FunctionParameter 'Scoped) - -deriving stock instance Eq (FunctionParameter 'Parsed) - -deriving stock instance Eq (FunctionParameter 'Scoped) - -deriving stock instance Ord (FunctionParameter 'Parsed) - -deriving stock instance Ord (FunctionParameter 'Scoped) - -data FunctionParameters (s :: Stage) = FunctionParameters - { _paramNames :: [FunctionParameter s], - _paramImplicit :: IsImplicit, - _paramDelims :: Delims, - _paramColon :: Irrelevant (Maybe KeywordRef), - _paramType :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (FunctionParameters 'Scoped) - -instance NFData (FunctionParameters 'Scoped) - -instance Serialize (FunctionParameters 'Parsed) - -instance NFData (FunctionParameters 'Parsed) - -deriving stock instance Show (FunctionParameters 'Parsed) - -deriving stock instance Show (FunctionParameters 'Scoped) - -deriving stock instance Eq (FunctionParameters 'Parsed) - -deriving stock instance Eq (FunctionParameters 'Scoped) - -deriving stock instance Ord (FunctionParameters 'Parsed) - -deriving stock instance Ord (FunctionParameters 'Scoped) - --- | Function *type* representation -data Function (s :: Stage) = Function - { _funParameters :: FunctionParameters s, - _funKw :: KeywordRef, - _funReturn :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (Function 'Scoped) - -instance NFData (Function 'Scoped) - -instance Serialize (Function 'Parsed) - -instance NFData (Function 'Parsed) - -deriving stock instance Show (Function 'Parsed) - -deriving stock instance Show (Function 'Scoped) - -deriving stock instance Eq (Function 'Parsed) - -deriving stock instance Eq (Function 'Scoped) - -deriving stock instance Ord (Function 'Parsed) - -deriving stock instance Ord (Function 'Scoped) - -data Lambda (s :: Stage) = Lambda - { _lambdaKw :: KeywordRef, - _lambdaBraces :: Irrelevant (KeywordRef, KeywordRef), - _lambdaClauses :: NonEmpty (LambdaClause s) - } - deriving stock (Generic) - -instance Serialize (Lambda 'Scoped) - -instance NFData (Lambda 'Scoped) - -instance Serialize (Lambda 'Parsed) - -instance NFData (Lambda 'Parsed) - -deriving stock instance Show (Lambda 'Parsed) - -deriving stock instance Show (Lambda 'Scoped) - -deriving stock instance Eq (Lambda 'Parsed) - -deriving stock instance Eq (Lambda 'Scoped) - -deriving stock instance Ord (Lambda 'Parsed) - -deriving stock instance Ord (Lambda 'Scoped) - -data LambdaClause (s :: Stage) = LambdaClause - { _lambdaPipe :: Irrelevant (Maybe KeywordRef), - _lambdaParameters :: NonEmpty (PatternAtomType s), - _lambdaAssignKw :: Irrelevant KeywordRef, - _lambdaBody :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (LambdaClause 'Scoped) - -instance NFData (LambdaClause 'Scoped) - -instance Serialize (LambdaClause 'Parsed) - -instance NFData (LambdaClause 'Parsed) - -deriving stock instance Show (LambdaClause 'Parsed) - -deriving stock instance Show (LambdaClause 'Scoped) - -deriving stock instance Eq (LambdaClause 'Parsed) - -deriving stock instance Eq (LambdaClause 'Scoped) - -deriving stock instance Ord (LambdaClause 'Parsed) - -deriving stock instance Ord (LambdaClause 'Scoped) - -data Application = Application - { _applicationFunction :: Expression, - _applicationParameter :: Expression - } - deriving stock (Show, Eq, Ord, Generic) - -instance Serialize Application - -instance NFData Application - -data InfixApplication = InfixApplication - { _infixAppLeft :: Expression, - _infixAppOperator :: ScopedIden, - _infixAppRight :: Expression - } - deriving stock (Show, Eq, Ord, Generic) - -instance Serialize InfixApplication - -instance NFData InfixApplication - -data PostfixApplication = PostfixApplication - { _postfixAppParameter :: Expression, - _postfixAppOperator :: ScopedIden - } - deriving stock (Show, Eq, Ord, Generic) - -instance Serialize PostfixApplication - -instance NFData PostfixApplication - -data LetStatement (s :: Stage) - = LetFunctionDef (FunctionDef s) - | LetAliasDef (AliasDef s) - | LetOpen (OpenModule s 'OpenFull) - deriving stock (Generic) - -instance Serialize (LetStatement 'Scoped) - -instance NFData (LetStatement 'Scoped) - -instance Serialize (LetStatement 'Parsed) - -instance NFData (LetStatement 'Parsed) - -deriving stock instance Show (LetStatement 'Parsed) - -deriving stock instance Show (LetStatement 'Scoped) - -deriving stock instance Eq (LetStatement 'Parsed) - -deriving stock instance Eq (LetStatement 'Scoped) - -deriving stock instance Ord (LetStatement 'Parsed) - -deriving stock instance Ord (LetStatement 'Scoped) - -data Let (s :: Stage) = Let - { _letKw :: KeywordRef, - _letInKw :: Irrelevant KeywordRef, - _letFunDefs :: NonEmpty (LetStatement s), - _letExpression :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (Let 'Scoped) - -instance NFData (Let 'Scoped) - -instance Serialize (Let 'Parsed) - -instance NFData (Let 'Parsed) - -deriving stock instance Show (Let 'Parsed) - -deriving stock instance Show (Let 'Scoped) - -deriving stock instance Eq (Let 'Parsed) - -deriving stock instance Eq (Let 'Scoped) - -deriving stock instance Ord (Let 'Parsed) - -deriving stock instance Ord (Let 'Scoped) - -data SideIfBranch (s :: Stage) (k :: IfBranchKind) = SideIfBranch - { _sideIfBranchPipe :: Irrelevant (Maybe KeywordRef), - _sideIfBranchKw :: Irrelevant KeywordRef, - _sideIfBranchCondition :: SideIfBranchConditionType s k, - _sideIfBranchAssignKw :: Irrelevant KeywordRef, - _sideIfBranchBody :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (SideIfBranch 'Scoped 'BranchIfBool) - -instance Serialize (SideIfBranch 'Scoped 'BranchIfElse) - -instance NFData (SideIfBranch 'Scoped 'BranchIfBool) - -instance NFData (SideIfBranch 'Scoped 'BranchIfElse) - -instance Serialize (SideIfBranch 'Parsed 'BranchIfBool) - -instance Serialize (SideIfBranch 'Parsed 'BranchIfElse) - -instance NFData (SideIfBranch 'Parsed 'BranchIfElse) - -instance NFData (SideIfBranch 'Parsed 'BranchIfBool) - -deriving stock instance Show (SideIfBranch 'Parsed 'BranchIfElse) - -deriving stock instance Show (SideIfBranch 'Parsed 'BranchIfBool) - -deriving stock instance Show (SideIfBranch 'Scoped 'BranchIfElse) - -deriving stock instance Show (SideIfBranch 'Scoped 'BranchIfBool) - -deriving stock instance Eq (SideIfBranch 'Parsed 'BranchIfElse) - -deriving stock instance Eq (SideIfBranch 'Parsed 'BranchIfBool) - -deriving stock instance Eq (SideIfBranch 'Scoped 'BranchIfElse) - -deriving stock instance Eq (SideIfBranch 'Scoped 'BranchIfBool) - -deriving stock instance Ord (SideIfBranch 'Parsed 'BranchIfElse) - -deriving stock instance Ord (SideIfBranch 'Parsed 'BranchIfBool) - -deriving stock instance Ord (SideIfBranch 'Scoped 'BranchIfElse) - -deriving stock instance Ord (SideIfBranch 'Scoped 'BranchIfBool) - -data SideIfs (s :: Stage) = SideIfs - { _sideIfBranches :: NonEmpty (SideIfBranch s 'BranchIfBool), - _sideIfElse :: Maybe (SideIfBranch s 'BranchIfElse) - } - deriving stock (Generic) - -instance Serialize (SideIfs 'Scoped) - -instance NFData (SideIfs 'Scoped) - -instance Serialize (SideIfs 'Parsed) - -instance NFData (SideIfs 'Parsed) - -deriving stock instance Show (SideIfs 'Parsed) - -deriving stock instance Show (SideIfs 'Scoped) - -deriving stock instance Eq (SideIfs 'Parsed) - -deriving stock instance Eq (SideIfs 'Scoped) - -deriving stock instance Ord (SideIfs 'Parsed) - -deriving stock instance Ord (SideIfs 'Scoped) - -data RhsExpression (s :: Stage) = RhsExpression - { _rhsExpressionAssignKw :: Irrelevant KeywordRef, - _rhsExpression :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (RhsExpression 'Scoped) - -instance NFData (RhsExpression 'Scoped) - -instance Serialize (RhsExpression 'Parsed) - -instance NFData (RhsExpression 'Parsed) - -deriving stock instance Show (RhsExpression 'Parsed) - -deriving stock instance Show (RhsExpression 'Scoped) - -deriving stock instance Eq (RhsExpression 'Parsed) - -deriving stock instance Eq (RhsExpression 'Scoped) - -deriving stock instance Ord (RhsExpression 'Parsed) - -deriving stock instance Ord (RhsExpression 'Scoped) - -data CaseBranchRhs (s :: Stage) - = CaseBranchRhsExpression (RhsExpression s) - | CaseBranchRhsIf (SideIfs s) - deriving stock (Generic) - -instance Serialize (CaseBranchRhs 'Scoped) - -instance NFData (CaseBranchRhs 'Scoped) - -instance Serialize (CaseBranchRhs 'Parsed) - -instance NFData (CaseBranchRhs 'Parsed) - -deriving stock instance Show (CaseBranchRhs 'Parsed) - -deriving stock instance Show (CaseBranchRhs 'Scoped) - -deriving stock instance Eq (CaseBranchRhs 'Parsed) - -deriving stock instance Eq (CaseBranchRhs 'Scoped) - -deriving stock instance Ord (CaseBranchRhs 'Parsed) - -deriving stock instance Ord (CaseBranchRhs 'Scoped) - -data CaseBranch (s :: Stage) = CaseBranch - { _caseBranchPipe :: Irrelevant (Maybe KeywordRef), - _caseBranchPattern :: PatternParensType s, - _caseBranchRhs :: CaseBranchRhs s - } - deriving stock (Generic) - -instance Serialize (CaseBranch 'Scoped) - -instance NFData (CaseBranch 'Scoped) - -instance Serialize (CaseBranch 'Parsed) - -instance NFData (CaseBranch 'Parsed) - -deriving stock instance Show (CaseBranch 'Parsed) - -deriving stock instance Show (CaseBranch 'Scoped) - -deriving stock instance Eq (CaseBranch 'Parsed) - -deriving stock instance Eq (CaseBranch 'Scoped) - -deriving stock instance Ord (CaseBranch 'Parsed) - -deriving stock instance Ord (CaseBranch 'Scoped) - -data Case (s :: Stage) = Case - { _caseKw :: KeywordRef, - _caseOfKw :: KeywordRef, - _caseExpression :: ExpressionType s, - _caseBranches :: NonEmpty (CaseBranch s) - } - deriving stock (Generic) - -instance Serialize (Case 'Scoped) - -instance NFData (Case 'Scoped) - -instance Serialize (Case 'Parsed) - -instance NFData (Case 'Parsed) - -deriving stock instance Show (Case 'Parsed) - -deriving stock instance Show (Case 'Scoped) - -deriving stock instance Eq (Case 'Parsed) - -deriving stock instance Eq (Case 'Scoped) - -deriving stock instance Ord (Case 'Parsed) - -deriving stock instance Ord (Case 'Scoped) - -data NewCaseBranch (s :: Stage) = NewCaseBranch - { _newCaseBranchPipe :: Irrelevant (Maybe KeywordRef), - _newCaseBranchAssignKw :: Irrelevant KeywordRef, - _newCaseBranchPattern :: PatternParensType s, - _newCaseBranchExpression :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (NewCaseBranch 'Scoped) - -instance NFData (NewCaseBranch 'Scoped) - -instance Serialize (NewCaseBranch 'Parsed) - -instance NFData (NewCaseBranch 'Parsed) - -deriving stock instance Show (NewCaseBranch 'Parsed) - -deriving stock instance Show (NewCaseBranch 'Scoped) - -deriving stock instance Eq (NewCaseBranch 'Parsed) - -deriving stock instance Eq (NewCaseBranch 'Scoped) - -deriving stock instance Ord (NewCaseBranch 'Parsed) - -deriving stock instance Ord (NewCaseBranch 'Scoped) - -data NewCase (s :: Stage) = NewCase - { _newCaseKw :: KeywordRef, - _newCaseOfKw :: KeywordRef, - _newCaseExpression :: ExpressionType s, - _newCaseBranches :: NonEmpty (NewCaseBranch s) - } - deriving stock (Generic) - -instance Serialize (NewCase 'Scoped) - -instance NFData (NewCase 'Scoped) - -instance Serialize (NewCase 'Parsed) - -instance NFData (NewCase 'Parsed) - -deriving stock instance Show (NewCase 'Parsed) - -deriving stock instance Show (NewCase 'Scoped) - -deriving stock instance Eq (NewCase 'Parsed) - -deriving stock instance Eq (NewCase 'Scoped) - -deriving stock instance Ord (NewCase 'Parsed) - -deriving stock instance Ord (NewCase 'Scoped) - -data IfBranch (s :: Stage) (k :: IfBranchKind) = IfBranch - { _ifBranchPipe :: Irrelevant KeywordRef, - _ifBranchAssignKw :: Irrelevant KeywordRef, - _ifBranchCondition :: IfBranchConditionType s k, - _ifBranchExpression :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (IfBranch 'Scoped 'BranchIfBool) - -instance Serialize (IfBranch 'Scoped 'BranchIfElse) - -instance NFData (IfBranch 'Scoped 'BranchIfBool) - -instance NFData (IfBranch 'Scoped 'BranchIfElse) - -instance Serialize (IfBranch 'Parsed 'BranchIfBool) - -instance Serialize (IfBranch 'Parsed 'BranchIfElse) - -instance NFData (IfBranch 'Parsed 'BranchIfElse) - -instance NFData (IfBranch 'Parsed 'BranchIfBool) - -deriving stock instance Show (IfBranch 'Parsed 'BranchIfElse) - -deriving stock instance Show (IfBranch 'Parsed 'BranchIfBool) - -deriving stock instance Show (IfBranch 'Scoped 'BranchIfElse) - -deriving stock instance Show (IfBranch 'Scoped 'BranchIfBool) - -deriving stock instance Eq (IfBranch 'Parsed 'BranchIfElse) - -deriving stock instance Eq (IfBranch 'Parsed 'BranchIfBool) - -deriving stock instance Eq (IfBranch 'Scoped 'BranchIfElse) - -deriving stock instance Eq (IfBranch 'Scoped 'BranchIfBool) - -deriving stock instance Ord (IfBranch 'Parsed 'BranchIfElse) - -deriving stock instance Ord (IfBranch 'Parsed 'BranchIfBool) - -deriving stock instance Ord (IfBranch 'Scoped 'BranchIfElse) - -deriving stock instance Ord (IfBranch 'Scoped 'BranchIfBool) - -data If (s :: Stage) = If - { _ifKw :: KeywordRef, - _ifBranches :: [IfBranch s 'BranchIfBool], - _ifBranchElse :: IfBranch s 'BranchIfElse - } - deriving stock (Generic) - -instance Serialize (If 'Scoped) - -instance NFData (If 'Scoped) - -instance Serialize (If 'Parsed) - -instance NFData (If 'Parsed) - -deriving stock instance Show (If 'Parsed) - -deriving stock instance Show (If 'Scoped) - -deriving stock instance Eq (If 'Parsed) - -deriving stock instance Eq (If 'Scoped) - -deriving stock instance Ord (If 'Parsed) - -deriving stock instance Ord (If 'Scoped) - -data Initializer (s :: Stage) = Initializer - { _initializerPattern :: PatternParensType s, - _initializerAssignKw :: Irrelevant KeywordRef, - _initializerExpression :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (Initializer 'Scoped) - -instance NFData (Initializer 'Scoped) - -instance Serialize (Initializer 'Parsed) - -instance NFData (Initializer 'Parsed) - -deriving stock instance Show (Initializer 'Parsed) - -deriving stock instance Show (Initializer 'Scoped) - -deriving stock instance Eq (Initializer 'Parsed) - -deriving stock instance Eq (Initializer 'Scoped) - -deriving stock instance Ord (Initializer 'Parsed) - -deriving stock instance Ord (Initializer 'Scoped) - -data Range (s :: Stage) = Range - { _rangePattern :: PatternParensType s, - _rangeInKw :: Irrelevant KeywordRef, - _rangeExpression :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (Range 'Scoped) - -instance NFData (Range 'Scoped) - -instance Serialize (Range 'Parsed) - -instance NFData (Range 'Parsed) - -deriving stock instance Show (Range 'Parsed) - -deriving stock instance Show (Range 'Scoped) - -deriving stock instance Eq (Range 'Parsed) - -deriving stock instance Eq (Range 'Scoped) - -deriving stock instance Ord (Range 'Parsed) - -deriving stock instance Ord (Range 'Scoped) - -data Iterator s = Iterator - { _iteratorName :: IdentifierType s, - _iteratorInitializers :: [Initializer s], - _iteratorRanges :: [Range s], - _iteratorBody :: ExpressionType s, - -- | Was the body enclosed in braces? - _iteratorBodyBraces :: Bool, - -- | Due to limitations of the pretty printing algorithm, we store whether - -- the iterator was surrounded by parentheses in the code. - _iteratorParens :: Bool - } - deriving stock (Generic) - -instance Serialize (Iterator 'Scoped) - -instance NFData (Iterator 'Scoped) - -instance Serialize (Iterator 'Parsed) - -instance NFData (Iterator 'Parsed) - -deriving stock instance Show (Iterator 'Parsed) - -deriving stock instance Show (Iterator 'Scoped) - -deriving stock instance Eq (Iterator 'Parsed) - -deriving stock instance Eq (Iterator 'Scoped) - -deriving stock instance Ord (Iterator 'Parsed) - -deriving stock instance Ord (Iterator 'Scoped) - -data List (s :: Stage) = List - { _listBracketL :: Irrelevant KeywordRef, - _listBracketR :: Irrelevant KeywordRef, - _listItems :: [ExpressionType s] - } - deriving stock (Generic) - -instance Serialize (List 'Scoped) - -instance NFData (List 'Scoped) - -instance Serialize (List 'Parsed) - -instance NFData (List 'Parsed) - -deriving stock instance Show (List 'Parsed) - -deriving stock instance Show (List 'Scoped) - -deriving stock instance Eq (List 'Parsed) - -deriving stock instance Eq (List 'Scoped) - -deriving stock instance Ord (List 'Parsed) - -deriving stock instance Ord (List 'Scoped) - -data NamedArgument (s :: Stage) = NamedArgument - { _namedArgName :: Symbol, - _namedArgAssignKw :: Irrelevant KeywordRef, - _namedArgValue :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (NamedArgument 'Scoped) - -instance NFData (NamedArgument 'Scoped) - -instance Serialize (NamedArgument 'Parsed) - -instance NFData (NamedArgument 'Parsed) - -deriving stock instance Show (NamedArgument 'Parsed) - -deriving stock instance Show (NamedArgument 'Scoped) - -deriving stock instance Eq (NamedArgument 'Parsed) - -deriving stock instance Eq (NamedArgument 'Scoped) - -deriving stock instance Ord (NamedArgument 'Parsed) - -deriving stock instance Ord (NamedArgument 'Scoped) - -data ArgumentBlock (s :: Stage) = ArgumentBlock - { _argBlockDelims :: Irrelevant (Maybe (KeywordRef, KeywordRef)), - _argBlockImplicit :: IsImplicit, - _argBlockArgs :: NonEmpty (NamedArgument s) - } - deriving stock (Generic) - -instance Serialize (ArgumentBlock 'Scoped) - -instance NFData (ArgumentBlock 'Scoped) - -instance Serialize (ArgumentBlock 'Parsed) - -instance NFData (ArgumentBlock 'Parsed) - -deriving stock instance Show (ArgumentBlock 'Parsed) - -deriving stock instance Show (ArgumentBlock 'Scoped) - -deriving stock instance Eq (ArgumentBlock 'Parsed) - -deriving stock instance Eq (ArgumentBlock 'Scoped) - -deriving stock instance Ord (ArgumentBlock 'Parsed) - -deriving stock instance Ord (ArgumentBlock 'Scoped) - -data RecordUpdateExtra = RecordUpdateExtra - { _recordUpdateExtraConstructor :: S.Symbol, - -- | Implicitly bound fields sorted by index - _recordUpdateExtraVars :: [S.Symbol] - } - deriving stock (Generic) - -instance Serialize RecordUpdateExtra - -instance NFData RecordUpdateExtra - -newtype ParensRecordUpdate = ParensRecordUpdate - { _parensRecordUpdate :: RecordUpdate 'Scoped - } - deriving stock (Show, Eq, Ord, Generic) - -instance Serialize ParensRecordUpdate - -instance NFData ParensRecordUpdate - -data RecordUpdate (s :: Stage) = RecordUpdate - { _recordUpdateAtKw :: Irrelevant KeywordRef, - _recordUpdateDelims :: Irrelevant (KeywordRef, KeywordRef), - _recordUpdateTypeName :: IdentifierType s, - _recordUpdateExtra :: Irrelevant (RecordUpdateExtraType s), - _recordUpdateFields :: [RecordUpdateField s] - } - deriving stock (Generic) - -instance Serialize (RecordUpdate 'Scoped) - -instance NFData (RecordUpdate 'Scoped) - -instance Serialize (RecordUpdate 'Parsed) - -instance NFData (RecordUpdate 'Parsed) - -deriving stock instance Show (RecordUpdate 'Parsed) - -deriving stock instance Show (RecordUpdate 'Scoped) - -deriving stock instance Eq (RecordUpdate 'Parsed) - -deriving stock instance Eq (RecordUpdate 'Scoped) - -deriving stock instance Ord (RecordUpdate 'Parsed) - -deriving stock instance Ord (RecordUpdate 'Scoped) - -data RecordUpdateApp = RecordUpdateApp - { _recordAppUpdate :: RecordUpdate 'Scoped, - _recordAppExpression :: Expression - } - deriving stock (Show, Eq, Ord, Generic) - -instance Serialize RecordUpdateApp - -instance NFData RecordUpdateApp - -data NamedApplication (s :: Stage) = NamedApplication - { _namedAppName :: IdentifierType s, - _namedAppArgs :: NonEmpty (ArgumentBlock s) - } - deriving stock (Generic) - -instance Serialize (NamedApplication 'Scoped) - -instance NFData (NamedApplication 'Scoped) - -instance Serialize (NamedApplication 'Parsed) - -instance NFData (NamedApplication 'Parsed) - -deriving stock instance Show (NamedApplication 'Parsed) - -deriving stock instance Show (NamedApplication 'Scoped) - -deriving stock instance Eq (NamedApplication 'Parsed) - -deriving stock instance Eq (NamedApplication 'Scoped) - -deriving stock instance Ord (NamedApplication 'Parsed) - -deriving stock instance Ord (NamedApplication 'Scoped) - -newtype NamedArgumentNew (s :: Stage) = NamedArgumentNew - { _namedArgumentNewFunDef :: FunctionDef s - } - deriving newtype (Generic) - -instance Serialize (NamedArgumentNew 'Scoped) - -instance NFData (NamedArgumentNew 'Scoped) - -instance Serialize (NamedArgumentNew 'Parsed) - -instance NFData (NamedArgumentNew 'Parsed) - -deriving stock instance Show (NamedArgumentNew 'Parsed) - -deriving stock instance Show (NamedArgumentNew 'Scoped) - -deriving stock instance Eq (NamedArgumentNew 'Parsed) - -deriving stock instance Eq (NamedArgumentNew 'Scoped) - -deriving stock instance Ord (NamedArgumentNew 'Parsed) - -deriving stock instance Ord (NamedArgumentNew 'Scoped) - -data NamedApplicationNew (s :: Stage) = NamedApplicationNew - { _namedApplicationNewName :: IdentifierType s, - _namedApplicationNewAtKw :: Irrelevant KeywordRef, - _namedApplicationNewExhaustive :: Bool, - _namedApplicationNewArguments :: [NamedArgumentNew s] - } - deriving stock (Generic) - -instance Serialize (NamedApplicationNew 'Scoped) - -instance NFData (NamedApplicationNew 'Scoped) - -instance Serialize (NamedApplicationNew 'Parsed) - -instance NFData (NamedApplicationNew 'Parsed) - -deriving stock instance Show (NamedApplicationNew 'Parsed) - -deriving stock instance Show (NamedApplicationNew 'Scoped) - -deriving stock instance Eq (NamedApplicationNew 'Parsed) - -deriving stock instance Eq (NamedApplicationNew 'Scoped) - -deriving stock instance Ord (NamedApplicationNew 'Parsed) - -deriving stock instance Ord (NamedApplicationNew 'Scoped) - -data RecordStatement (s :: Stage) - = RecordStatementField (RecordField s) - | RecordStatementOperator OperatorSyntaxDef - deriving stock (Generic) - -instance Serialize (RecordStatement 'Scoped) - -instance NFData (RecordStatement 'Scoped) - -deriving stock instance Show (RecordStatement 'Parsed) - -deriving stock instance Show (RecordStatement 'Scoped) - -deriving stock instance Eq (RecordStatement 'Parsed) - -deriving stock instance Eq (RecordStatement 'Scoped) - -deriving stock instance Ord (RecordStatement 'Parsed) - -deriving stock instance Ord (RecordStatement 'Scoped) - --- | Expressions without application -data ExpressionAtom (s :: Stage) - = AtomIdentifier (IdentifierType s) - | AtomLambda (Lambda s) - | AtomList (List s) - | AtomCase (Case s) - | AtomIf (If s) - | AtomHole (HoleType s) - | AtomInstanceHole (HoleType s) - | AtomDoubleBraces (DoubleBracesExpression s) - | AtomBraces (WithLoc (ExpressionType s)) - | AtomLet (Let s) - | AtomRecordUpdate (RecordUpdate s) - | AtomUniverse Universe - | AtomFunction (Function s) - | AtomFunArrow KeywordRef - | AtomLiteral LiteralLoc - | AtomParens (ExpressionType s) - | AtomIterator (Iterator s) - | AtomNamedApplication (NamedApplication s) - | AtomNamedApplicationNew (NamedApplicationNew s) - deriving stock (Generic) - -instance Serialize (ExpressionAtom 'Parsed) - -instance NFData (ExpressionAtom 'Parsed) - -deriving stock instance Show (ExpressionAtom 'Parsed) - -deriving stock instance Show (ExpressionAtom 'Scoped) - -deriving stock instance Eq (ExpressionAtom 'Parsed) - -deriving stock instance Eq (ExpressionAtom 'Scoped) - -deriving stock instance Ord (ExpressionAtom 'Parsed) - -deriving stock instance Ord (ExpressionAtom 'Scoped) - -data ExpressionAtoms (s :: Stage) = ExpressionAtoms - { _expressionAtoms :: NonEmpty (ExpressionAtom s), - _expressionAtomsLoc :: Irrelevant Interval - } - deriving stock (Generic) - -instance Serialize (ExpressionAtoms 'Parsed) - -instance NFData (ExpressionAtoms 'Parsed) - -deriving stock instance Show (ExpressionAtoms 'Parsed) - -deriving stock instance Show (ExpressionAtoms 'Scoped) - -deriving stock instance Eq (ExpressionAtoms 'Parsed) - -deriving stock instance Eq (ExpressionAtoms 'Scoped) - -deriving stock instance Ord (ExpressionAtoms 'Parsed) - -deriving stock instance Ord (ExpressionAtoms 'Scoped) - -newtype Judoc (s :: Stage) = Judoc - { _judocGroups :: NonEmpty (JudocGroup s) - } - deriving newtype (Semigroup, Generic) - -instance Serialize (Judoc 'Scoped) - -instance NFData (Judoc 'Scoped) - -instance Serialize (Judoc 'Parsed) - -instance NFData (Judoc 'Parsed) - -deriving stock instance Show (Judoc 'Parsed) - -deriving stock instance Show (Judoc 'Scoped) - -deriving stock instance Eq (Judoc 'Parsed) - -deriving stock instance Eq (Judoc 'Scoped) - -deriving stock instance Ord (Judoc 'Parsed) - -deriving stock instance Ord (Judoc 'Scoped) - -data Example (s :: Stage) = Example - { _exampleId :: NameId, - _exampleLoc :: Interval, - _exampleExpression :: ExpressionType s - } - deriving stock (Generic) - -instance Serialize (Example 'Scoped) - -instance NFData (Example 'Scoped) - -instance Serialize (Example 'Parsed) - -instance NFData (Example 'Parsed) - -deriving stock instance Show (Example 'Parsed) - -deriving stock instance Show (Example 'Scoped) - -deriving stock instance Eq (Example 'Parsed) - -deriving stock instance Eq (Example 'Scoped) - -deriving stock instance Ord (Example 'Parsed) - -deriving stock instance Ord (Example 'Scoped) - -data JudocBlockParagraph (s :: Stage) = JudocBlockParagraph - { _judocBlockParagraphStart :: KeywordRef, - _judocBlockParagraphBlocks :: [JudocBlock s], - _judocBlockParagraphEnd :: KeywordRef - } - deriving stock (Generic) - -instance Serialize (JudocBlockParagraph 'Scoped) - -instance NFData (JudocBlockParagraph 'Scoped) - -instance Serialize (JudocBlockParagraph 'Parsed) - -instance NFData (JudocBlockParagraph 'Parsed) - -deriving stock instance Show (JudocBlockParagraph 'Parsed) - -deriving stock instance Show (JudocBlockParagraph 'Scoped) - -deriving stock instance Eq (JudocBlockParagraph 'Parsed) - -deriving stock instance Eq (JudocBlockParagraph 'Scoped) - -deriving stock instance Ord (JudocBlockParagraph 'Parsed) - -deriving stock instance Ord (JudocBlockParagraph 'Scoped) - -data JudocGroup (s :: Stage) - = JudocGroupBlock (JudocBlockParagraph s) - | JudocGroupLines (NonEmpty (JudocBlock s)) - deriving stock (Generic) - -instance Serialize (JudocGroup 'Scoped) - -instance NFData (JudocGroup 'Scoped) - -instance Serialize (JudocGroup 'Parsed) - -instance NFData (JudocGroup 'Parsed) - -deriving stock instance Show (JudocGroup 'Parsed) - -deriving stock instance Show (JudocGroup 'Scoped) - -deriving stock instance Eq (JudocGroup 'Parsed) - -deriving stock instance Eq (JudocGroup 'Scoped) - -deriving stock instance Ord (JudocGroup 'Parsed) - -deriving stock instance Ord (JudocGroup 'Scoped) - -newtype JudocBlock (s :: Stage) - = JudocLines (NonEmpty (JudocLine s)) - deriving stock (Generic) - -instance Serialize (JudocBlock 'Scoped) - -instance NFData (JudocBlock 'Scoped) - -instance Serialize (JudocBlock 'Parsed) - -instance NFData (JudocBlock 'Parsed) - -deriving stock instance Show (JudocBlock 'Parsed) - -deriving stock instance Show (JudocBlock 'Scoped) - -deriving stock instance Eq (JudocBlock 'Parsed) - -deriving stock instance Eq (JudocBlock 'Scoped) - -deriving stock instance Ord (JudocBlock 'Parsed) - -deriving stock instance Ord (JudocBlock 'Scoped) - -data JudocLine (s :: Stage) = JudocLine - { _judocLineDelim :: Maybe KeywordRef, - _judocLineAtoms :: NonEmpty (WithLoc (JudocAtom s)) - } - deriving stock (Generic) - -instance Serialize (JudocLine 'Scoped) - -instance NFData (JudocLine 'Scoped) - -instance Serialize (JudocLine 'Parsed) - -instance NFData (JudocLine 'Parsed) - -deriving stock instance Show (JudocLine 'Parsed) - -deriving stock instance Show (JudocLine 'Scoped) - -deriving stock instance Eq (JudocLine 'Parsed) - -deriving stock instance Eq (JudocLine 'Scoped) - -deriving stock instance Ord (JudocLine 'Parsed) - -deriving stock instance Ord (JudocLine 'Scoped) - -data JudocAtom (s :: Stage) - = JudocExpression (ExpressionType s) - | JudocText Text - deriving stock (Generic) - -instance Serialize (JudocAtom 'Scoped) - -instance NFData (JudocAtom 'Scoped) - -instance Serialize (JudocAtom 'Parsed) - -instance NFData (JudocAtom 'Parsed) - -deriving stock instance Show (JudocAtom 'Parsed) - -deriving stock instance Show (JudocAtom 'Scoped) - -deriving stock instance Eq (JudocAtom 'Parsed) - -deriving stock instance Eq (JudocAtom 'Scoped) - -deriving stock instance Ord (JudocAtom 'Parsed) - -deriving stock instance Ord (JudocAtom 'Scoped) - -makeLenses ''SideIfs -makeLenses ''SideIfBranch -makeLenses ''RhsExpression -makeLenses ''PatternArg -makeLenses ''WildcardConstructor -makeLenses ''DoubleBracesExpression -makeLenses ''FieldPun -makeLenses ''RecordPatternAssign -makeLenses ''RecordPattern -makeLenses ''ParensRecordUpdate -makeLenses ''RecordUpdateExtra -makeLenses ''RecordUpdate -makeLenses ''RecordUpdateApp -makeLenses ''RecordUpdateField -makeLenses ''NonDefinitionsSection -makeLenses ''DefinitionsSection -makeLenses ''ProjectionDef -makeLenses ''ScopedIden -makeLenses ''FixityDef -makeLenses ''RecordField -makeLenses ''RhsRecord -makeLenses ''RhsAdt -makeLenses ''RhsGadt -makeLenses ''List -makeLenses ''ListPattern -makeLenses ''UsingItem -makeLenses ''HidingItem -makeLenses ''HidingList -makeLenses ''UsingList -makeLenses ''JudocLine -makeLenses ''Example -makeLenses ''Lambda -makeLenses ''LambdaClause -makeLenses ''Judoc -makeLenses ''JudocBlockParagraph -makeLenses ''Function -makeLenses ''InductiveDef -makeLenses ''PostfixApplication -makeLenses ''InfixApplication -makeLenses ''Application -makeLenses ''Let -makeLenses ''FunctionParameters -makeLenses ''Import -makeLenses ''OperatorSyntaxDef -makeLenses ''IteratorSyntaxDef -makeLenses ''ConstructorDef -makeLenses ''Module -makeLenses ''SigArg -makeLenses ''ArgDefault -makeLenses ''FunctionDef -makeLenses ''AxiomDef -makeLenses ''InductiveParameters -makeLenses ''InductiveParametersRhs -makeLenses ''OpenModule -makeLenses ''PatternApp -makeLenses ''PatternInfixApp -makeLenses ''PatternPostfixApp -makeLenses ''Case -makeLenses ''CaseBranch -makeLenses ''If -makeLenses ''IfBranch -makeLenses ''PatternBinding -makeLenses ''PatternAtoms -makeLenses ''ExpressionAtoms -makeLenses ''Iterator -makeLenses ''Initializer -makeLenses ''Range -makeLenses ''ArgumentBlock -makeLenses ''NamedArgument -makeLenses ''NamedApplication -makeLenses ''NamedArgumentNew -makeLenses ''NamedApplicationNew -makeLenses ''AliasDef -makeLenses ''FixitySyntaxDef -makeLenses ''ParsedFixityInfo -makeLenses ''ParsedFixityFields -makeLenses ''NameSignature -makeLenses ''RecordNameSignature -makeLenses ''NameBlock -makeLenses ''NameItem -makeLenses ''RecordInfo -makeLenses ''MarkdownInfo - -fixityFieldHelper :: SimpleGetter (ParsedFixityFields s) (Maybe a) -> SimpleGetter (ParsedFixityInfo s) (Maybe a) -fixityFieldHelper l = to (^? fixityFields . _Just . l . _Just) - -fixityAssoc :: SimpleGetter (ParsedFixityInfo s) (Maybe (BinaryAssoc)) -fixityAssoc = fixityFieldHelper fixityFieldsAssoc - -fixityPrecSame :: SimpleGetter (ParsedFixityInfo s) (Maybe (SymbolType s)) -fixityPrecSame = fixityFieldHelper fixityFieldsPrecSame - -fixityPrecAbove :: SimpleGetter (ParsedFixityInfo s) (Maybe [SymbolType s]) -fixityPrecAbove = fixityFieldHelper fixityFieldsPrecAbove - -fixityPrecBelow :: SimpleGetter (ParsedFixityInfo s) (Maybe [SymbolType s]) -fixityPrecBelow = fixityFieldHelper fixityFieldsPrecBelow - -instance (SingI s) => HasLoc (AliasDef s) where - getLoc AliasDef {..} = getLoc _aliasDefSyntaxKw <> getLocIdentifierType _aliasDefAsName - -instance HasLoc (ParsedFixityFields s) where - getLoc d = getLoc l <> getLoc r - where - (l, r) = d ^. fixityFieldsBraces . unIrrelevant - -instance HasLoc (ParsedFixityInfo s) where - getLoc def = getLoc (def ^. fixityParsedArity) <>? (getLoc <$> def ^. fixityFields) - -instance HasLoc (FixitySyntaxDef s) where - getLoc def = getLoc (def ^. fixitySyntaxKw) <> getLoc (def ^. fixityInfo) - -instance (SingI s) => HasLoc (SyntaxDef s) where - getLoc = \case - SyntaxFixity t -> getLoc t - SyntaxOperator t -> getLoc t - SyntaxIterator t -> getLoc t - SyntaxAlias t -> getLoc t - -instance (SingI s) => HasLoc (NamedArgument s) where - getLoc NamedArgument {..} = getLocSymbolType _namedArgName <> getLocExpressionType _namedArgValue - -instance (SingI s) => HasLoc (ArgumentBlock s) where - getLoc ArgumentBlock {..} = case d of - Just (l, r) -> getLoc l <> getLoc r - Nothing -> getLocSpan _argBlockArgs - where - Irrelevant d = _argBlockDelims - -instance HasAtomicity (ArgumentBlock s) where - atomicity = const Atom - -instance HasAtomicity (NamedApplication s) where - atomicity = const (Aggregate appFixity) - -instance HasAtomicity (NamedApplicationNew s) where - atomicity = const (Aggregate updateFixity) - -instance HasAtomicity Expression where - atomicity e = case e of - ExpressionIdentifier {} -> Atom - ExpressionHole {} -> Atom - ExpressionInstanceHole {} -> Atom - ExpressionParensIdentifier {} -> Atom - ExpressionApplication {} -> Aggregate appFixity - ExpressionInfixApplication a -> Aggregate (getFixity a) - ExpressionPostfixApplication a -> Aggregate (getFixity a) - ExpressionLambda l -> atomicity l - ExpressionLiteral l -> atomicity l - ExpressionLet l -> atomicity l - ExpressionBraces {} -> Atom - ExpressionDoubleBraces {} -> Atom - ExpressionList {} -> Atom - ExpressionUniverse {} -> Atom - ExpressionFunction {} -> Aggregate funFixity - ExpressionCase c -> atomicity c - ExpressionIf x -> atomicity x - ExpressionIterator i -> atomicity i - ExpressionNamedApplication i -> atomicity i - ExpressionNamedApplicationNew i -> atomicity i - ExpressionRecordUpdate {} -> Aggregate updateFixity - ExpressionParensRecordUpdate {} -> Atom - -expressionAtomicity :: forall s. (SingI s) => ExpressionType s -> Atomicity -expressionAtomicity e = case sing :: SStage s of - SParsed -> atomicity e - SScoped -> atomicity e - -instance HasAtomicity (Iterator s) where - atomicity = const Atom - -instance HasAtomicity (Case s) where - atomicity = const Atom - -instance HasAtomicity (If s) where - atomicity = const Atom - -instance HasAtomicity (Let 'Scoped) where - atomicity l = atomicity (l ^. letExpression) - -instance HasAtomicity (PatternAtom 'Parsed) where - atomicity = const Atom - -instance (SingI s) => HasAtomicity (FunctionParameters s) where - atomicity p - | not (null (p ^. paramNames)) - || p ^. paramImplicit == Implicit - || p ^. paramImplicit == ImplicitInstance = - Atom - | otherwise = case sing :: SStage s of - SParsed -> atomicity (p ^. paramType) - SScoped -> atomicity (p ^. paramType) - -instance Pretty ScopedIden where - pretty = pretty . (^. scopedIdenSrcName) - -instance HasLoc ScopedIden where - getLoc = getLoc . (^. scopedIdenSrcName) - -instance (SingI s) => HasLoc (InductiveParameters s) where - getLoc i = getLocSymbolType (i ^. inductiveParametersNames . _head1) <>? (getLocExpressionType <$> (i ^? inductiveParametersRhs . _Just . inductiveParametersType)) - -instance HasLoc (InductiveDef s) where - getLoc i = (getLoc <$> i ^. inductivePositive) ?<> getLoc (i ^. inductiveKw) - -instance (SingI s) => HasLoc (AxiomDef s) where - getLoc m = getLoc (m ^. axiomKw) <> getLocExpressionType (m ^. axiomType) - -getLocPublicAnn :: PublicAnn -> Maybe Interval -getLocPublicAnn p = getLoc <$> p ^? _Public - -instance HasLoc (OpenModule s short) where - getLoc OpenModule {..} = - getLoc _openModuleKw - <>? fmap getLoc _openModuleUsingHiding - <>? getLocPublicAnn _openModulePublic - -instance HasLoc (ProjectionDef s) where - getLoc = getLoc . (^. projectionConstructor) - -instance HasLoc (Statement 'Scoped) where - getLoc :: Statement 'Scoped -> Interval - getLoc = \case - StatementSyntax t -> getLoc t - StatementFunctionDef t -> getLoc t - StatementImport t -> getLoc t - StatementInductive t -> getLoc t - StatementModule t -> getLoc t - StatementOpenModule t -> getLoc t - StatementAxiom t -> getLoc t - StatementProjectionDef t -> getLoc t - -instance HasLoc Application where - getLoc (Application l r) = getLoc l <> getLoc r - -instance HasLoc InfixApplication where - getLoc (InfixApplication l _ r) = getLoc l <> getLoc r - -instance HasLoc PostfixApplication where - getLoc (PostfixApplication l o) = getLoc l <> getLoc o - -instance HasLoc (LambdaClause 'Scoped) where - getLoc c = - fmap getLoc (c ^. lambdaPipe . unIrrelevant) - ?<> getLocSpan (c ^. lambdaParameters) - <> getLoc (c ^. lambdaBody) - -instance HasLoc (Lambda 'Scoped) where - getLoc l = getLoc (l ^. lambdaKw) <> getLoc (l ^. lambdaBraces . unIrrelevant . _2) - -instance HasLoc (FunctionParameter 'Scoped) where - getLoc = \case - FunctionParameterName n -> getLoc n - FunctionParameterWildcard w -> getLoc w - -instance HasLoc (FunctionParameters 'Scoped) where - getLoc p = case p ^. paramDelims . unIrrelevant of - Nothing -> (getLoc <$> listToMaybe (p ^. paramNames)) ?<> getLoc (p ^. paramType) - Just (l, r) -> getLoc l <> getLoc r - -instance HasLoc (Function 'Scoped) where - getLoc f = getLoc (f ^. funParameters) <> getLoc (f ^. funReturn) - -instance HasLoc (Let 'Scoped) where - getLoc l = getLoc (l ^. letKw) <> getLoc (l ^. letExpression) - -instance (SingI s) => HasLoc (SideIfBranch s k) where - getLoc SideIfBranch {..} = - (getLoc <$> _sideIfBranchPipe ^. unIrrelevant) - ?<> getLocExpressionType _sideIfBranchBody - -instance (SingI s) => HasLoc (SideIfs s) where - getLoc SideIfs {..} = - getLocSpan _sideIfBranches - <>? (getLoc <$> _sideIfElse) - -instance (SingI s) => HasLoc (RhsExpression s) where - getLoc RhsExpression {..} = - getLoc _rhsExpressionAssignKw - <> getLocExpressionType _rhsExpression - -instance (SingI s) => HasLoc (CaseBranchRhs s) where - getLoc = \case - CaseBranchRhsExpression e -> getLoc e - CaseBranchRhsIf e -> getLoc e - -instance (SingI s) => HasLoc (CaseBranch s) where - getLoc c = case c ^. caseBranchPipe . unIrrelevant of - Nothing -> branchLoc - Just p -> getLoc p <> branchLoc - where - branchLoc :: Interval - branchLoc = getLoc (c ^. caseBranchRhs) - -instance (SingI s) => HasLoc (IfBranch s k) where - getLoc c = getLoc (c ^. ifBranchPipe) <> getLocExpressionType (c ^. ifBranchExpression) - -instance (SingI s) => HasLoc (Case s) where - getLoc c = getLoc (c ^. caseKw) <> getLoc (c ^. caseBranches . to last) - -instance (SingI s) => HasLoc (If s) where - getLoc c = getLoc (c ^. ifKw) <> getLoc (c ^. ifBranchElse) - -instance HasLoc (List s) where - getLoc List {..} = getLoc _listBracketL <> getLoc _listBracketR - -instance (SingI s) => HasLoc (NamedApplication s) where - getLoc NamedApplication {..} = getLocIdentifierType _namedAppName <> getLoc (last _namedAppArgs) - -instance (SingI s) => HasLoc (NamedApplicationNew s) where - getLoc NamedApplicationNew {..} = getLocIdentifierType _namedApplicationNewName - -instance (SingI s) => HasLoc (RecordUpdateField s) where - getLoc f = getLocSymbolType (f ^. fieldUpdateName) <> getLocExpressionType (f ^. fieldUpdateValue) - -instance HasLoc (RecordUpdate s) where - getLoc r = getLoc (r ^. recordUpdateAtKw) <> getLoc (r ^. recordUpdateDelims . unIrrelevant . _2) - -instance HasLoc RecordUpdateApp where - getLoc r = getLoc (r ^. recordAppExpression) <> getLoc (r ^. recordAppUpdate) - -instance HasLoc ParensRecordUpdate where - getLoc = getLoc . (^. parensRecordUpdate) - -instance HasLoc (DoubleBracesExpression s) where - getLoc DoubleBracesExpression {..} = - let (l, r) = _doubleBracesDelims ^. unIrrelevant - in getLoc l <> getLoc r - -instance HasAtomicity (DoubleBracesExpression s) where - atomicity = const Atom - -instance HasLoc Expression where - getLoc = \case - ExpressionIdentifier i -> getLoc i - ExpressionParensIdentifier i -> getLoc i - ExpressionApplication i -> getLoc i - ExpressionInfixApplication i -> getLoc i - ExpressionPostfixApplication i -> getLoc i - ExpressionLambda i -> getLoc i - ExpressionList l -> getLoc l - ExpressionCase i -> getLoc i - ExpressionIf x -> getLoc x - ExpressionLet i -> getLoc i - ExpressionUniverse i -> getLoc i - ExpressionLiteral i -> getLoc i - ExpressionFunction i -> getLoc i - ExpressionHole i -> getLoc i - ExpressionInstanceHole i -> getLoc i - ExpressionBraces i -> getLoc i - ExpressionDoubleBraces i -> getLoc i - ExpressionIterator i -> getLoc i - ExpressionNamedApplication i -> getLoc i - ExpressionNamedApplicationNew i -> getLoc i - ExpressionRecordUpdate i -> getLoc i - ExpressionParensRecordUpdate i -> getLoc i - -getLocIdentifierType :: forall s. (SingI s) => IdentifierType s -> Interval -getLocIdentifierType e = case sing :: SStage s of - SParsed -> getLoc e - SScoped -> getLoc e - -instance (SingI s) => HasLoc (Iterator s) where - getLoc Iterator {..} = getLocIdentifierType _iteratorName <> getLocExpressionType _iteratorBody - -instance HasLoc (HidingList s) where - getLoc HidingList {..} = - let rbra = _hidingBraces ^. unIrrelevant . _2 - in getLoc (_hidingKw ^. unIrrelevant) <> getLoc rbra - -instance HasLoc (UsingList s) where - getLoc UsingList {..} = - let rbra = _usingBraces ^. unIrrelevant . _2 - in getLoc (_usingKw ^. unIrrelevant) <> getLoc rbra - -instance HasLoc (UsingHiding s) where - getLoc = \case - Using u -> getLoc u - Hiding u -> getLoc u - -instance (SingI s) => HasLoc (Import s) where - getLoc Import {..} = - let sLoc = case sing :: SStage s of - SParsed -> - getLoc _importKw - <> getLoc _importModulePath - <>? (getLoc <$> _importOpen) - SScoped -> - getLoc _importKw - <> getLoc _importModulePath - <>? (getLoc <$> _importOpen) - in sLoc <>? fmap getLoc (_importPublic ^? _Public) - -instance (SingI s, SingI t) => HasLoc (Module s t) where - getLoc m = case sing :: SStage s of - SParsed -> case sing :: SModuleIsTop t of - SModuleLocal -> getLoc (m ^. modulePath) - SModuleTop -> getLoc (m ^. modulePath) - SScoped -> case sing :: SModuleIsTop t of - SModuleLocal -> getLoc (m ^. modulePath) - SModuleTop -> getLoc (m ^. modulePath) - -getLocSymbolType :: forall s. (SingI s) => SymbolType s -> Interval -getLocSymbolType = case sing :: SStage s of - SParsed -> getLoc - SScoped -> getLoc - -getLocExpressionType :: forall s. (SingI s) => ExpressionType s -> Interval -getLocExpressionType = case sing :: SStage s of - SParsed -> getLoc - SScoped -> getLoc - -instance (SingI s) => HasLoc (ArgDefault s) where - getLoc ArgDefault {..} = getLoc _argDefaultAssign <> getLocExpressionType _argDefaultValue - -instance HasLoc (SigArg s) where - getLoc SigArg {..} = getLoc l <> getLoc r - where - Irrelevant (l, r) = _sigArgDelims - -instance (SingI s) => HasLoc (FunctionClause s) where - getLoc FunctionClause {..} = - getLoc _clausenPipeKw - <> getLocExpressionType _clausenBody - -instance (SingI s) => HasLoc (FunctionDefBody s) where - getLoc = \case - SigBodyExpression e -> getLocExpressionType e - SigBodyClauses cl -> getLocSpan cl - -instance (SingI s) => HasLoc (FunctionDef s) where - getLoc FunctionDef {..} = - (getLoc <$> _signDoc) - ?<> (getLoc <$> _signPragmas) - ?<> (getLoc <$> _signBuiltin) - ?<> (getLoc <$> _signTerminating) - ?<> getLocSymbolType _signName - <> getLoc _signBody - -instance HasLoc (Example s) where - getLoc e = e ^. exampleLoc - -instance HasLoc (Judoc s) where - getLoc (Judoc j) = getLocSpan j - -instance HasLoc (JudocBlockParagraph s) where - getLoc p = getLoc (p ^. judocBlockParagraphStart) <> getLoc (p ^. judocBlockParagraphEnd) - -instance HasLoc (JudocGroup s) where - getLoc = \case - JudocGroupBlock l -> getLoc l - JudocGroupLines l -> getLocSpan l - -instance HasLoc (JudocBlock s) where - getLoc = \case - JudocLines ls -> getLocSpan ls - -instance HasLoc PatternScopedIden where - getLoc = \case - PatternScopedVar v -> getLoc v - PatternScopedConstructor c -> getLoc c - -instance HasLoc PatternBinding where - getLoc PatternBinding {..} = getLoc _patternBindingName <> getLoc _patternBindingPattern - -instance HasLoc (ListPattern s) where - getLoc l = getLoc (l ^. listpBracketL) <> getLoc (l ^. listpBracketR) - -getLocPatternParensType :: forall s. (SingI s) => PatternParensType s -> Interval -getLocPatternParensType = case sing :: SStage s of - SScoped -> getLoc - SParsed -> getLoc - -instance (SingI s) => HasLoc (RecordPatternAssign s) where - getLoc a = - getLoc (a ^. recordPatternAssignField) - <> getLocPatternParensType (a ^. recordPatternAssignPattern) - -instance (SingI s) => HasLoc (FieldPun s) where - getLoc f = getLocSymbolType (f ^. fieldPunField) - -instance (SingI s) => HasLoc (RecordPatternItem s) where - getLoc = \case - RecordPatternItemAssign a -> getLoc a - RecordPatternItemFieldPun a -> getLoc a - -instance (SingI s) => HasLoc (RecordPattern s) where - getLoc r = getLocIdentifierType (r ^. recordPatternConstructor) <>? (getLocSpan <$> nonEmpty (r ^. recordPatternItems)) - -instance (SingI s) => HasLoc (WildcardConstructor s) where - getLoc WildcardConstructor {..} = - getLocIdentifierType _wildcardConstructor - -instance (SingI s) => HasLoc (PatternAtom s) where - getLoc = \case - PatternAtomIden i -> getLocIden i - PatternAtomWildcard w -> getLoc w - PatternAtomWildcardConstructor w -> getLoc w - PatternAtomEmpty i -> i - PatternAtomList l -> getLoc l - PatternAtomParens p -> getLocParens p - PatternAtomBraces p -> getLocParens p - PatternAtomDoubleBraces p -> getLocParens p - PatternAtomAt p -> getLocAt p - PatternAtomRecord p -> getLoc p - where - getLocAt :: forall r. (SingI r) => PatternAtType r -> Interval - getLocAt p = case sing :: SStage r of - SParsed -> getLoc p - SScoped -> getLoc p - getLocIden :: forall r. (SingI r) => PatternAtomIdenType r -> Interval - getLocIden p = case sing :: SStage r of - SParsed -> getLoc p - SScoped -> getLoc p - getLocParens :: forall r. (SingI r) => PatternParensType r -> Interval - getLocParens p = case sing :: SStage r of - SParsed -> getLoc p - SScoped -> getLoc p - -instance HasLoc (JudocLine s) where - getLoc (JudocLine delim atoms) = fmap getLoc delim ?<> getLocSpan atoms - -instance HasLoc (PatternAtoms s) where - getLoc = getLoc . (^. patternAtomsLoc) - -instance HasLoc PatternArg where - getLoc a = fmap getLoc (a ^. patternArgName) ?<> getLoc (a ^. patternArgPattern) - -instance HasLoc PatternInfixApp where - getLoc (PatternInfixApp l _ r) = - getLoc l <> getLoc r - -instance HasLoc PatternPostfixApp where - getLoc (PatternPostfixApp l _) = getLoc l - -instance HasLoc PatternApp where - getLoc (PatternApp l r) = getLoc l <> getLoc r - -instance HasLoc Pattern where - getLoc = \case - PatternVariable v -> getLoc v - PatternWildcardConstructor v -> getLoc v - PatternConstructor c -> getLoc c - PatternApplication a -> getLoc a - PatternWildcard w -> getLoc w - PatternList w -> getLoc w - PatternEmpty i -> i - PatternInfixApplication i -> getLoc i - PatternPostfixApplication i -> getLoc i - PatternRecord i -> getLoc i - -instance HasLoc (ExpressionAtoms s) where - getLoc = getLoc . (^. expressionAtomsLoc) - -instance HasAtomicity (ExpressionAtoms 'Parsed) where - atomicity ExpressionAtoms {..} = case _expressionAtoms of - (_ :| []) -> Atom - (_ :| _) - | any isArrow _expressionAtoms -> Aggregate funFixity - | otherwise -> Aggregate appFixity - where - isArrow :: ExpressionAtom s -> Bool - isArrow = \case - AtomFunArrow {} -> True - _ -> False - -data ApeLeaf - = ApeLeafExpression Expression - | ApeLeafFunctionParams (FunctionParameters 'Scoped) - | ApeLeafArgumentBlock (AnyStage ArgumentBlock) - | ApeLeafFunctionKw KeywordRef - | ApeLeafPattern Pattern - | ApeLeafPatternArg PatternArg - | ApeLeafAtom (AnyStage ExpressionAtom) - -instance IsApe PatternApp ApeLeaf where - toApe (PatternApp l r) = - ApeApp - Ape.App - { _appLeft = toApe l, - _appRight = toApe r - } - -instance IsApe Pattern ApeLeaf where - toApe = \case - PatternApplication a -> toApe a - PatternInfixApplication a -> toApe a - PatternPostfixApplication a -> toApe a - e -> - ApeLeaf - ( Leaf - { _leafAtomicity = atomicity e, - _leafExpr = ApeLeafPattern e - } - ) - -instance IsApe PatternArg ApeLeaf where - toApe pa - | Atom == atomicity pa = - ApeLeaf - ( Leaf - { _leafAtomicity = Atom, - _leafExpr = ApeLeafPatternArg pa - } - ) - | otherwise = toApe (pa ^. patternArgPattern) - -instance IsApe PatternPostfixApp ApeLeaf where - toApe p@(PatternPostfixApp l op) = - ApePostfix - Postfix - { _postfixFixity = getFixity p, - _postfixLeft = toApe l, - _postfixOp = ApeLeafPattern (PatternConstructor op) - } - -instance IsApe PatternInfixApp ApeLeaf where - toApe i@(PatternInfixApp l op r) = - ApeInfix - Infix - { _infixFixity = getFixity i, - _infixLeft = toApe l, - _infixRight = toApe r, - _infixIsDelimiter = isDelimiterStr (prettyText (op ^. scopedIdenSrcName . S.nameConcrete)), - _infixOp = ApeLeafPattern (PatternConstructor op) - } - -instance IsApe ScopedIden ApeLeaf where - toApe iden = - ApeLeaf - ( Leaf - { _leafAtomicity = Atom, - _leafExpr = ApeLeafExpression (ExpressionIdentifier iden) - } - ) - -instance (SingI s) => IsApe (ArgumentBlock s) ApeLeaf where - toApe b = - ApeLeaf - ( Leaf - { _leafAtomicity = atomicity b, - _leafExpr = ApeLeafArgumentBlock (sing :&: b) - } - ) - -toApeIdentifierType :: forall s. (SingI s) => IdentifierType s -> Ape ApeLeaf -toApeIdentifierType = case sing :: SStage s of - SParsed -> toApe - SScoped -> toApe - -instance IsApe Name ApeLeaf where - toApe n = - ApeLeaf - ( Leaf - { _leafAtomicity = atomicity n, - _leafExpr = ApeLeafAtom (sing :&: AtomIdentifier n) - } - ) - -instance (SingI s) => IsApe (NamedApplication s) ApeLeaf where - toApe NamedApplication {..} = mkApps f (toApe <$> _namedAppArgs) - where - f = toApeIdentifierType _namedAppName - -instance (SingI s) => IsApe (NamedApplicationNew s) ApeLeaf where - toApe a = - ApeLeaf $ - Leaf - { _leafAtomicity = atomicity a, - _leafExpr = ApeLeafAtom (sing :&: AtomNamedApplicationNew a) - } - -instance IsApe Application ApeLeaf where - toApe (Application l r) = - ApeApp - Ape.App - { _appLeft = toApe l, - _appRight = toApe r - } - -instance IsApe InfixApplication ApeLeaf where - toApe i@(InfixApplication l op r) = - ApeInfix - Infix - { _infixFixity = getFixity i, - _infixLeft = toApe l, - _infixRight = toApe r, - _infixIsDelimiter = isDelimiterStr (prettyText (op ^. scopedIdenSrcName . S.nameConcrete)), - _infixOp = ApeLeafExpression (ExpressionIdentifier op) - } - -instance IsApe PostfixApplication ApeLeaf where - toApe p@(PostfixApplication l op) = - ApePostfix - Postfix - { _postfixFixity = getFixity p, - _postfixLeft = toApe l, - _postfixOp = ApeLeafExpression (ExpressionIdentifier op) - } - -instance IsApe (Function 'Scoped) ApeLeaf where - toApe (Function ps kw ret) = - ApeInfix - Infix - { _infixFixity = funFixity, - _infixLeft = toApe ps, - _infixRight = toApe ret, - _infixIsDelimiter = False, - _infixOp = ApeLeafFunctionKw kw - } - -instance IsApe RecordUpdateApp ApeLeaf where - toApe :: RecordUpdateApp -> Ape ApeLeaf - toApe a = - ApePostfix - Postfix - { _postfixFixity = updateFixity, - _postfixOp = ApeLeafAtom (sing :&: AtomRecordUpdate (a ^. recordAppUpdate)), - _postfixLeft = toApe (a ^. recordAppExpression) - } - -instance IsApe Expression ApeLeaf where - toApe e = case e of - ExpressionApplication a -> toApe a - ExpressionInfixApplication a -> toApe a - ExpressionPostfixApplication a -> toApe a - ExpressionFunction a -> toApe a - ExpressionNamedApplication a -> toApe a - ExpressionNamedApplicationNew a -> toApe a - ExpressionRecordUpdate a -> toApe a - ExpressionParensRecordUpdate {} -> leaf - ExpressionParensIdentifier {} -> leaf - ExpressionIdentifier {} -> leaf - ExpressionList {} -> leaf - ExpressionCase {} -> leaf - ExpressionIf {} -> leaf - ExpressionLambda {} -> leaf - ExpressionLet {} -> leaf - ExpressionUniverse {} -> leaf - ExpressionHole {} -> leaf - ExpressionInstanceHole {} -> leaf - ExpressionLiteral {} -> leaf - ExpressionBraces {} -> leaf - ExpressionDoubleBraces {} -> leaf - ExpressionIterator {} -> leaf - where - leaf = - ApeLeaf - ( Leaf - { _leafAtomicity = atomicity e, - _leafExpr = ApeLeafExpression e - } - ) - -instance IsApe (FunctionParameters 'Scoped) ApeLeaf where - toApe f - | atomicity f == Atom = - ApeLeaf - ( Leaf - { _leafAtomicity = Atom, - _leafExpr = ApeLeafFunctionParams f - } - ) - | otherwise = toApe (f ^. paramType) - -instance HasAtomicity PatternArg where - atomicity p - | Implicit <- p ^. patternArgIsImplicit = Atom - | ImplicitInstance <- p ^. patternArgIsImplicit = Atom - | isJust (p ^. patternArgName) = Atom - | otherwise = atomicity (p ^. patternArgPattern) - -instance HasNameKind ScopedIden where - getNameKind = getNameKind . (^. scopedIdenFinal) - getNameKindPretty = getNameKindPretty . (^. scopedIdenFinal) - -_ConstructorRhsRecord :: Traversal' (ConstructorRhs s) (RhsRecord s) -_ConstructorRhsRecord f rhs = case rhs of - ConstructorRhsRecord r -> ConstructorRhsRecord <$> f r - _ -> pure rhs - -_DefinitionSyntax :: Traversal' (Definition s) (SyntaxDef s) -_DefinitionSyntax f x = case x of - DefinitionSyntax r -> DefinitionSyntax <$> f r - _ -> pure x - -_SyntaxAlias :: Traversal' (SyntaxDef s) (AliasDef s) -_SyntaxAlias f x = case x of - SyntaxAlias r -> SyntaxAlias <$> f r - _ -> pure x - -_RecordStatementField :: Traversal' (RecordStatement s) (RecordField s) -_RecordStatementField f x = case x of - RecordStatementField p -> RecordStatementField <$> f p - _ -> pure x - -scopedIdenSrcName :: Lens' ScopedIden S.Name -scopedIdenSrcName f n = case n ^. scopedIdenAlias of - Nothing -> scopedIdenFinal f n - Just a -> do - a' <- f a - pure (set scopedIdenAlias (Just a') n) - -fromParsedIteratorInfo :: ParsedIteratorInfo -> IteratorInfo -fromParsedIteratorInfo ParsedIteratorInfo {..} = - IteratorInfo - { _iteratorInfoInitNum = (^. withLocParam) <$> _parsedIteratorInfoInitNum, - _iteratorInfoRangeNum = (^. withLocParam) <$> _parsedIteratorInfoRangeNum - } - -instance HasFixity PostfixApplication where - getFixity (PostfixApplication _ op) = fromMaybe impossible (op ^. scopedIdenSrcName . S.nameFixity) - -instance HasFixity InfixApplication where - getFixity (InfixApplication _ op _) = fromMaybe impossible (op ^. scopedIdenSrcName . S.nameFixity) - -instance HasFixity PatternInfixApp where - getFixity (PatternInfixApp _ op _) = fromMaybe impossible (op ^. scopedIdenSrcName . S.nameFixity) - -instance HasFixity PatternPostfixApp where - getFixity (PatternPostfixApp _ op) = fromMaybe impossible (op ^. scopedIdenSrcName . S.nameFixity) - -instance HasAtomicity (ListPattern s) where - atomicity = const Atom - -instance HasAtomicity (RecordPattern s) where - atomicity = const Atom - -instance HasAtomicity (WildcardConstructor s) where - atomicity = const Atom - -instance HasAtomicity Pattern where - atomicity e = case e of - PatternVariable {} -> Atom - PatternWildcardConstructor a -> atomicity a - PatternConstructor {} -> Atom - PatternApplication {} -> Aggregate appFixity - PatternInfixApplication a -> Aggregate (getFixity a) - PatternPostfixApplication p -> Aggregate (getFixity p) - PatternWildcard {} -> Atom - PatternList l -> atomicity l - PatternEmpty {} -> Atom - PatternRecord r -> atomicity r +import Juvix.Compiler.Concrete.Language.Base +import Juvix.Compiler.Concrete.Language.IsApeInstances diff --git a/src/Juvix/Compiler/Concrete/Language/Base.hs b/src/Juvix/Compiler/Concrete/Language/Base.hs new file mode 100644 index 0000000000..29109f3225 --- /dev/null +++ b/src/Juvix/Compiler/Concrete/Language/Base.hs @@ -0,0 +1,3278 @@ +{-# LANGUAGE UndecidableInstances #-} + +module Juvix.Compiler.Concrete.Language.Base + ( module Juvix.Compiler.Concrete.Language.Base, + module Juvix.Data.FixityInfo, + module Juvix.Compiler.Concrete.Data.IsOpenShort, + module Juvix.Compiler.Concrete.Data.LocalModuleOrigin, + module Juvix.Data.IteratorInfo, + module Juvix.Compiler.Concrete.Data.IfBranchKind, + module Juvix.Compiler.Concrete.Data.Name, + module Juvix.Compiler.Concrete.Data.Stage, + module Juvix.Compiler.Concrete.Data.NameRef, + module Juvix.Data.Keyword, + module Juvix.Compiler.Concrete.Data.Builtins, + module Juvix.Compiler.Concrete.Data.Literal, + module Juvix.Data, + module Juvix.Compiler.Concrete.Data.VisibilityAnn, + module Juvix.Compiler.Concrete.Data.PublicAnn, + module Juvix.Compiler.Concrete.Data.ModuleIsTop, + module Juvix.Data.Fixity, + ) +where + +import Juvix.Compiler.Backend.Markdown.Data.Types (Mk) +import Juvix.Compiler.Concrete.Data.Builtins +import Juvix.Compiler.Concrete.Data.IfBranchKind +import Juvix.Compiler.Concrete.Data.IsOpenShort +import Juvix.Compiler.Concrete.Data.Literal +import Juvix.Compiler.Concrete.Data.LocalModuleOrigin +import Juvix.Compiler.Concrete.Data.ModuleIsTop +import Juvix.Compiler.Concrete.Data.Name +import Juvix.Compiler.Concrete.Data.NameRef +import Juvix.Compiler.Concrete.Data.PublicAnn +import Juvix.Compiler.Concrete.Data.ScopedName qualified as S +import Juvix.Compiler.Concrete.Data.Stage +import Juvix.Compiler.Concrete.Data.VisibilityAnn +import Juvix.Data +import Juvix.Data.Fixity +import Juvix.Data.FixityInfo (Arity (..), FixityInfo) +import Juvix.Data.IteratorInfo +import Juvix.Data.Keyword +import Juvix.Extra.Serialize as Ser +import Juvix.Prelude hiding (show) +import Juvix.Prelude.Pretty (Pretty, pretty) + +type Delims = Irrelevant (Maybe (KeywordRef, KeywordRef)) + +type RecordUpdateExtraType :: Stage -> GHCType +type family RecordUpdateExtraType s = res | res -> s where + RecordUpdateExtraType 'Parsed = () + RecordUpdateExtraType 'Scoped = RecordUpdateExtra + +type FieldArgIxType :: Stage -> GHCType +type family FieldArgIxType s = res | res -> s where + FieldArgIxType 'Parsed = () + FieldArgIxType 'Scoped = Int + +type SideIfBranchConditionType :: Stage -> IfBranchKind -> GHCType +type family SideIfBranchConditionType s k = res where + SideIfBranchConditionType s 'BranchIfBool = ExpressionType s + SideIfBranchConditionType _ 'BranchIfElse = () + +type IfBranchConditionType :: Stage -> IfBranchKind -> GHCType +type family IfBranchConditionType s k = res where + IfBranchConditionType s 'BranchIfBool = ExpressionType s + IfBranchConditionType _ 'BranchIfElse = Irrelevant KeywordRef + +type ModuleIdType :: Stage -> ModuleIsTop -> GHCType +type family ModuleIdType s t = res where + ModuleIdType 'Parsed _ = () + ModuleIdType 'Scoped 'ModuleLocal = () + ModuleIdType 'Scoped 'ModuleTop = ModuleId + +type SymbolType :: Stage -> GHCType +type family SymbolType s = res | res -> s where + SymbolType 'Parsed = Symbol + SymbolType 'Scoped = S.Symbol + +type IdentifierType :: Stage -> GHCType +type family IdentifierType s = res | res -> s where + IdentifierType 'Parsed = Name + IdentifierType 'Scoped = ScopedIden + +type HoleType :: Stage -> GHCType +type family HoleType s = res | res -> s where + HoleType 'Parsed = KeywordRef + HoleType 'Scoped = Hole + +type PatternAtomIdenType :: Stage -> GHCType +type family PatternAtomIdenType s = res | res -> s where + PatternAtomIdenType 'Parsed = Name + PatternAtomIdenType 'Scoped = PatternScopedIden + +type ExpressionType :: Stage -> GHCType +type family ExpressionType s = res | res -> s where + ExpressionType 'Parsed = ExpressionAtoms 'Parsed + ExpressionType 'Scoped = Expression + +type PatternAtomType :: Stage -> GHCType +type family PatternAtomType s = res | res -> s where + PatternAtomType 'Parsed = PatternAtom 'Parsed + PatternAtomType 'Scoped = PatternArg + +type PatternParensType :: Stage -> GHCType +type family PatternParensType s = res | res -> s where + PatternParensType 'Parsed = PatternAtoms 'Parsed + PatternParensType 'Scoped = PatternArg + +type PatternAtType :: Stage -> GHCType +type family PatternAtType s = res | res -> s where + PatternAtType 'Parsed = PatternBinding + PatternAtType 'Scoped = PatternArg + +type NameSignatureType :: Stage -> GHCType +type family NameSignatureType s = res | res -> s where + NameSignatureType 'Parsed = () + NameSignatureType 'Scoped = NameSignature 'Scoped + +type ModulePathType :: Stage -> ModuleIsTop -> GHCType +type family ModulePathType s t = res | res -> t s where + ModulePathType 'Parsed 'ModuleTop = TopModulePath + ModulePathType 'Scoped 'ModuleTop = S.TopModulePath + ModulePathType 'Parsed 'ModuleLocal = Symbol + ModulePathType 'Scoped 'ModuleLocal = S.Symbol + +type OpenModuleNameType :: Stage -> IsOpenShort -> GHCType +type family OpenModuleNameType s short = res where + OpenModuleNameType s 'OpenFull = ModuleNameType s + OpenModuleNameType _ 'OpenShort = () + +type ModuleNameType :: Stage -> GHCType +type family ModuleNameType s = res | res -> s where + ModuleNameType 'Parsed = Name + ModuleNameType 'Scoped = S.Name + +type ModuleInductiveType :: ModuleIsTop -> GHCType +type family ModuleInductiveType t = res | res -> t where + ModuleInductiveType 'ModuleTop = () + ModuleInductiveType 'ModuleLocal = LocalModuleOrigin + +type ModuleEndType :: ModuleIsTop -> GHCType +type family ModuleEndType t = res | res -> t where + ModuleEndType 'ModuleTop = () + ModuleEndType 'ModuleLocal = KeywordRef + +-- | We keep the exact source of the pragma text. This is necessary, because +-- pragmas are supposed to be backwards-compatible. Unrecognised pragmas +-- should be ignored, but they still need to be printed out when +-- pretty-printing. Also, we probably don't want to impose pragma formatting +-- choices on the user. +type ParsedPragmas = WithLoc (WithSource Pragmas) + +data NameItem (s :: Stage) = NameItem + { _nameItemSymbol :: SymbolType s, + _nameItemIndex :: Int, + _nameItemType :: ExpressionType s, + _nameItemDefault :: Maybe (ArgDefault s) + } + deriving stock (Generic) + +instance Serialize (NameItem 'Scoped) + +instance NFData (NameItem 'Scoped) + +instance Serialize (NameItem 'Parsed) + +instance NFData (NameItem 'Parsed) + +data NameBlock (s :: Stage) = NameBlock + { -- | Symbols map to themselves so we can retrieve the location + -- | NOTE the index is wrt to the block, not the whole signature. + _nameBlock :: HashMap Symbol (NameItem s), + _nameImplicit :: IsImplicit + } + deriving stock (Generic) + +instance Serialize (NameBlock 'Scoped) + +instance NFData (NameBlock 'Scoped) + +instance Serialize (NameBlock 'Parsed) + +instance NFData (NameBlock 'Parsed) + +-- | Two consecutive blocks should have different implicitness +newtype NameSignature (s :: Stage) = NameSignature + { _nameSignatureArgs :: [NameBlock s] + } + deriving stock (Generic) + +instance Serialize (NameSignature 'Scoped) + +instance NFData (NameSignature 'Scoped) + +instance Serialize (NameSignature 'Parsed) + +instance NFData (NameSignature 'Parsed) + +newtype RecordNameSignature s = RecordNameSignature + { _recordNames :: HashMap Symbol (NameItem s) + } + deriving stock (Generic) + +instance Serialize (RecordNameSignature 'Scoped) + +instance NFData (RecordNameSignature 'Scoped) + +instance Serialize (RecordNameSignature 'Parsed) + +instance NFData (RecordNameSignature 'Parsed) + +data RecordInfo = RecordInfo + { _recordInfoConstructor :: S.Symbol, + _recordInfoSignature :: RecordNameSignature 'Parsed + } + deriving stock (Generic) + +instance Serialize RecordInfo + +instance NFData RecordInfo + +data Argument (s :: Stage) + = ArgumentSymbol (SymbolType s) + | ArgumentWildcard Wildcard + deriving stock (Generic) + +instance Serialize (Argument 'Scoped) + +instance NFData (Argument 'Scoped) + +instance Serialize (Argument 'Parsed) + +instance NFData (Argument 'Parsed) + +deriving stock instance Show (Argument 'Parsed) + +deriving stock instance Show (Argument 'Scoped) + +deriving stock instance Eq (Argument 'Parsed) + +deriving stock instance Eq (Argument 'Scoped) + +deriving stock instance Ord (Argument 'Parsed) + +deriving stock instance Ord (Argument 'Scoped) + +-- | We group consecutive definitions and reserve symbols in advance, so that we +-- don't need extra syntax for mutually recursive definitions. Also, it allows +-- us to be more flexible with the ordering of the definitions. +data StatementSections (s :: Stage) + = SectionsDefinitions (DefinitionsSection s) + | SectionsNonDefinitions (NonDefinitionsSection s) + | SectionsEmpty + +data DefinitionsSection (s :: Stage) = DefinitionsSection + { _definitionsSection :: NonEmpty (Definition s), + _definitionsNext :: Maybe (NonDefinitionsSection s) + } + +data NonDefinitionsSection (s :: Stage) = NonDefinitionsSection + { _nonDefinitionsSection :: NonEmpty (NonDefinition s), + _nonDefinitionsNext :: Maybe (DefinitionsSection s) + } + +data Definition (s :: Stage) + = DefinitionSyntax (SyntaxDef s) + | DefinitionFunctionDef (FunctionDef s) + | DefinitionInductive (InductiveDef s) + | DefinitionAxiom (AxiomDef s) + | DefinitionProjectionDef (ProjectionDef s) + +data NonDefinition (s :: Stage) + = NonDefinitionImport (Import s) + | NonDefinitionModule (Module s 'ModuleLocal) + | NonDefinitionOpenModule (OpenModule s 'OpenFull) + +data Statement (s :: Stage) + = StatementSyntax (SyntaxDef s) + | StatementFunctionDef (FunctionDef s) + | StatementImport (Import s) + | StatementInductive (InductiveDef s) + | StatementModule (Module s 'ModuleLocal) + | StatementOpenModule (OpenModule s 'OpenFull) + | StatementAxiom (AxiomDef s) + | StatementProjectionDef (ProjectionDef s) + +deriving stock instance Show (Statement 'Parsed) + +deriving stock instance Show (Statement 'Scoped) + +deriving stock instance Eq (Statement 'Parsed) + +deriving stock instance Eq (Statement 'Scoped) + +deriving stock instance Ord (Statement 'Parsed) + +deriving stock instance Ord (Statement 'Scoped) + +data ProjectionDef s = ProjectionDef + { _projectionConstructor :: S.Symbol, + _projectionField :: SymbolType s, + _projectionFieldIx :: Int, + _projectionFieldBuiltin :: Maybe (WithLoc BuiltinFunction), + _projectionDoc :: Maybe (Judoc s), + _projectionPragmas :: Maybe ParsedPragmas + } + +deriving stock instance Show (ProjectionDef 'Parsed) + +deriving stock instance Show (ProjectionDef 'Scoped) + +deriving stock instance Eq (ProjectionDef 'Parsed) + +deriving stock instance Eq (ProjectionDef 'Scoped) + +deriving stock instance Ord (ProjectionDef 'Parsed) + +deriving stock instance Ord (ProjectionDef 'Scoped) + +data Import (s :: Stage) = Import + { _importKw :: KeywordRef, + _importModulePath :: ModulePathType s 'ModuleTop, + _importAsName :: Maybe (ModulePathType s 'ModuleTop), + _importUsingHiding :: Maybe (UsingHiding s), + _importPublic :: PublicAnn, + _importOpen :: Maybe (OpenModule s 'OpenShort) + } + +deriving stock instance Show (Import 'Parsed) + +deriving stock instance Show (Import 'Scoped) + +deriving stock instance Eq (Import 'Parsed) + +deriving stock instance Eq (Import 'Scoped) + +deriving stock instance Ord (Import 'Parsed) + +deriving stock instance Ord (Import 'Scoped) + +data AliasDef (s :: Stage) = AliasDef + { _aliasDefSyntaxKw :: Irrelevant KeywordRef, + _aliasDefAliasKw :: Irrelevant KeywordRef, + _aliasDefName :: SymbolType s, + _aliasDefAsName :: IdentifierType s + } + deriving stock (Generic) + +instance Serialize (AliasDef 'Scoped) + +instance NFData (AliasDef 'Scoped) + +instance Serialize (AliasDef 'Parsed) + +instance NFData (AliasDef 'Parsed) + +deriving stock instance (Show (AliasDef 'Parsed)) + +deriving stock instance (Show (AliasDef 'Scoped)) + +deriving stock instance (Eq (AliasDef 'Parsed)) + +deriving stock instance (Eq (AliasDef 'Scoped)) + +deriving stock instance (Ord (AliasDef 'Parsed)) + +deriving stock instance (Ord (AliasDef 'Scoped)) + +data ParsedIteratorInfo = ParsedIteratorInfo + { _parsedIteratorInfoInitNum :: Maybe (WithLoc Int), + _parsedIteratorInfoRangeNum :: Maybe (WithLoc Int), + _parsedIteratorInfoBraces :: Irrelevant (KeywordRef, KeywordRef) + } + deriving stock (Show, Eq, Ord, Generic) + +data SyntaxDef (s :: Stage) + = SyntaxFixity (FixitySyntaxDef s) + | SyntaxOperator OperatorSyntaxDef + | SyntaxIterator IteratorSyntaxDef + | SyntaxAlias (AliasDef s) + +deriving stock instance (Show (SyntaxDef 'Parsed)) + +deriving stock instance (Show (SyntaxDef 'Scoped)) + +deriving stock instance (Eq (SyntaxDef 'Parsed)) + +deriving stock instance (Eq (SyntaxDef 'Scoped)) + +deriving stock instance (Ord (SyntaxDef 'Parsed)) + +deriving stock instance (Ord (SyntaxDef 'Scoped)) + +data ParsedFixityFields (s :: Stage) = ParsedFixityFields + { _fixityFieldsAssoc :: Maybe BinaryAssoc, + _fixityFieldsPrecSame :: Maybe (SymbolType s), + _fixityFieldsPrecBelow :: Maybe [SymbolType s], + _fixityFieldsPrecAbove :: Maybe [SymbolType s], + _fixityFieldsBraces :: Irrelevant (KeywordRef, KeywordRef) + } + +deriving stock instance (Show (ParsedFixityFields 'Parsed)) + +deriving stock instance (Show (ParsedFixityFields 'Scoped)) + +deriving stock instance (Eq (ParsedFixityFields 'Parsed)) + +deriving stock instance (Eq (ParsedFixityFields 'Scoped)) + +deriving stock instance (Ord (ParsedFixityFields 'Parsed)) + +deriving stock instance (Ord (ParsedFixityFields 'Scoped)) + +data ParsedFixityInfo (s :: Stage) = ParsedFixityInfo + { _fixityParsedArity :: WithLoc Arity, + _fixityFields :: Maybe (ParsedFixityFields s) + } + +deriving stock instance (Show (ParsedFixityInfo 'Parsed)) + +deriving stock instance (Show (ParsedFixityInfo 'Scoped)) + +deriving stock instance (Eq (ParsedFixityInfo 'Parsed)) + +deriving stock instance (Eq (ParsedFixityInfo 'Scoped)) + +deriving stock instance (Ord (ParsedFixityInfo 'Parsed)) + +deriving stock instance (Ord (ParsedFixityInfo 'Scoped)) + +data FixitySyntaxDef (s :: Stage) = FixitySyntaxDef + { _fixitySymbol :: SymbolType s, + _fixityDoc :: Maybe (Judoc s), + _fixityInfo :: ParsedFixityInfo s, + _fixityKw :: KeywordRef, + _fixityAssignKw :: KeywordRef, + _fixitySyntaxKw :: KeywordRef + } + +deriving stock instance (Show (FixitySyntaxDef 'Parsed)) + +deriving stock instance (Show (FixitySyntaxDef 'Scoped)) + +deriving stock instance (Eq (FixitySyntaxDef 'Parsed)) + +deriving stock instance (Eq (FixitySyntaxDef 'Scoped)) + +deriving stock instance (Ord (FixitySyntaxDef 'Parsed)) + +deriving stock instance (Ord (FixitySyntaxDef 'Scoped)) + +data FixityDef = FixityDef + { _fixityDefSymbol :: S.Symbol, + _fixityDefFixity :: Fixity, + -- | Used internally for printing parentheses. + _fixityDefPrec :: Int + } + deriving stock (Show, Eq, Ord, Generic) + +instance Serialize FixityDef + +instance NFData FixityDef + +data OperatorSyntaxDef = OperatorSyntaxDef + { _opSymbol :: Symbol, + _opFixity :: Symbol, + _opKw :: KeywordRef, + _opSyntaxKw :: KeywordRef + } + deriving stock (Show, Eq, Ord, Generic) + +instance Serialize OperatorSyntaxDef + +instance NFData OperatorSyntaxDef + +instance HasLoc OperatorSyntaxDef where + getLoc OperatorSyntaxDef {..} = getLoc _opSyntaxKw <> getLoc _opSymbol + +data IteratorSyntaxDef = IteratorSyntaxDef + { _iterSymbol :: Symbol, + _iterInfo :: Maybe ParsedIteratorInfo, + _iterSyntaxKw :: KeywordRef, + _iterIteratorKw :: KeywordRef + } + deriving stock (Show, Eq, Ord) + +instance HasLoc IteratorSyntaxDef where + getLoc IteratorSyntaxDef {..} = getLoc _iterSyntaxKw <> getLoc _iterSymbol + +data ArgDefault (s :: Stage) = ArgDefault + { _argDefaultAssign :: Irrelevant KeywordRef, + _argDefaultValue :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (ArgDefault 'Scoped) + +instance NFData (ArgDefault 'Scoped) + +instance Serialize (ArgDefault 'Parsed) + +instance NFData (ArgDefault 'Parsed) + +deriving stock instance Show (ArgDefault 'Parsed) + +deriving stock instance Show (ArgDefault 'Scoped) + +deriving stock instance Eq (ArgDefault 'Parsed) + +deriving stock instance Eq (ArgDefault 'Scoped) + +deriving stock instance Ord (ArgDefault 'Parsed) + +deriving stock instance Ord (ArgDefault 'Scoped) + +data SigArg (s :: Stage) = SigArg + { _sigArgDelims :: Irrelevant (KeywordRef, KeywordRef), + _sigArgImplicit :: IsImplicit, + -- | Allowed to be empty only for Instance arguments + _sigArgNames :: [Argument s], + _sigArgColon :: Maybe (Irrelevant KeywordRef), + -- | The type is only optional for implicit arguments. Omitting the rhs is + -- equivalent to writing `: Type`. + _sigArgType :: Maybe (ExpressionType s), + _sigArgDefault :: Maybe (ArgDefault s) + } + deriving stock (Generic) + +instance Serialize (SigArg 'Scoped) + +instance NFData (SigArg 'Scoped) + +instance Serialize (SigArg 'Parsed) + +instance NFData (SigArg 'Parsed) + +deriving stock instance Show (SigArg 'Parsed) + +deriving stock instance Show (SigArg 'Scoped) + +deriving stock instance Eq (SigArg 'Parsed) + +deriving stock instance Eq (SigArg 'Scoped) + +deriving stock instance Ord (SigArg 'Parsed) + +deriving stock instance Ord (SigArg 'Scoped) + +data FunctionClause (s :: Stage) = FunctionClause + { _clausenPipeKw :: Irrelevant KeywordRef, + _clausenPatterns :: NonEmpty (PatternAtomType s), + _clausenAssignKw :: Irrelevant KeywordRef, + _clausenBody :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (FunctionClause 'Scoped) + +instance NFData (FunctionClause 'Scoped) + +instance Serialize (FunctionClause 'Parsed) + +instance NFData (FunctionClause 'Parsed) + +deriving stock instance Show (FunctionClause 'Parsed) + +deriving stock instance Show (FunctionClause 'Scoped) + +deriving stock instance Eq (FunctionClause 'Parsed) + +deriving stock instance Eq (FunctionClause 'Scoped) + +deriving stock instance Ord (FunctionClause 'Parsed) + +deriving stock instance Ord (FunctionClause 'Scoped) + +data FunctionDefBody (s :: Stage) + = SigBodyExpression (ExpressionType s) + | SigBodyClauses (NonEmpty (FunctionClause s)) + deriving stock (Generic) + +instance Serialize (FunctionDefBody 'Scoped) + +instance NFData (FunctionDefBody 'Scoped) + +instance Serialize (FunctionDefBody 'Parsed) + +instance NFData (FunctionDefBody 'Parsed) + +deriving stock instance Show (FunctionDefBody 'Parsed) + +deriving stock instance Show (FunctionDefBody 'Scoped) + +deriving stock instance Eq (FunctionDefBody 'Parsed) + +deriving stock instance Eq (FunctionDefBody 'Scoped) + +deriving stock instance Ord (FunctionDefBody 'Parsed) + +deriving stock instance Ord (FunctionDefBody 'Scoped) + +data FunctionDef (s :: Stage) = FunctionDef + { _signName :: FunctionName s, + _signArgs :: [SigArg s], + _signColonKw :: Irrelevant (Maybe KeywordRef), + _signRetType :: Maybe (ExpressionType s), + _signDoc :: Maybe (Judoc s), + _signPragmas :: Maybe ParsedPragmas, + _signBuiltin :: Maybe (WithLoc BuiltinFunction), + _signBody :: FunctionDefBody s, + _signTerminating :: Maybe KeywordRef, + _signInstance :: Maybe KeywordRef, + _signCoercion :: Maybe KeywordRef + } + deriving stock (Generic) + +instance Serialize (FunctionDef 'Scoped) + +instance NFData (FunctionDef 'Scoped) + +instance Serialize (FunctionDef 'Parsed) + +instance NFData (FunctionDef 'Parsed) + +deriving stock instance Show (FunctionDef 'Parsed) + +deriving stock instance Show (FunctionDef 'Scoped) + +deriving stock instance Eq (FunctionDef 'Parsed) + +deriving stock instance Eq (FunctionDef 'Scoped) + +deriving stock instance Ord (FunctionDef 'Parsed) + +deriving stock instance Ord (FunctionDef 'Scoped) + +data AxiomDef (s :: Stage) = AxiomDef + { _axiomKw :: Irrelevant KeywordRef, + _axiomDoc :: Maybe (Judoc s), + _axiomPragmas :: Maybe ParsedPragmas, + _axiomName :: SymbolType s, + _axiomColonKw :: Irrelevant KeywordRef, + _axiomBuiltin :: Maybe (WithLoc BuiltinAxiom), + _axiomType :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (AxiomDef 'Scoped) + +instance NFData (AxiomDef 'Scoped) + +deriving stock instance Show (AxiomDef 'Parsed) + +deriving stock instance Show (AxiomDef 'Scoped) + +deriving stock instance Eq (AxiomDef 'Parsed) + +deriving stock instance Eq (AxiomDef 'Scoped) + +deriving stock instance Ord (AxiomDef 'Parsed) + +deriving stock instance Ord (AxiomDef 'Scoped) + +type InductiveConstructorName s = SymbolType s + +type InductiveName s = SymbolType s + +data ConstructorDef (s :: Stage) = ConstructorDef + { _constructorPipe :: Irrelevant (Maybe KeywordRef), + _constructorName :: InductiveConstructorName s, + _constructorInductiveName :: InductiveName s, + _constructorDoc :: Maybe (Judoc s), + _constructorPragmas :: Maybe ParsedPragmas, + _constructorRhs :: ConstructorRhs s + } + deriving stock (Generic) + +instance Serialize (ConstructorDef 'Scoped) + +instance NFData (ConstructorDef 'Scoped) + +deriving stock instance Show (ConstructorDef 'Parsed) + +deriving stock instance Show (ConstructorDef 'Scoped) + +deriving stock instance Eq (ConstructorDef 'Parsed) + +deriving stock instance Eq (ConstructorDef 'Scoped) + +deriving stock instance Ord (ConstructorDef 'Parsed) + +deriving stock instance Ord (ConstructorDef 'Scoped) + +data RecordUpdateField (s :: Stage) = RecordUpdateField + { _fieldUpdateName :: Symbol, + _fieldUpdateArgIx :: FieldArgIxType s, + _fieldUpdateAssignKw :: Irrelevant (KeywordRef), + _fieldUpdateValue :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (RecordUpdateField 'Scoped) + +instance NFData (RecordUpdateField 'Scoped) + +instance Serialize (RecordUpdateField 'Parsed) + +instance NFData (RecordUpdateField 'Parsed) + +deriving stock instance Show (RecordUpdateField 'Parsed) + +deriving stock instance Show (RecordUpdateField 'Scoped) + +deriving stock instance Eq (RecordUpdateField 'Parsed) + +deriving stock instance Eq (RecordUpdateField 'Scoped) + +deriving stock instance Ord (RecordUpdateField 'Parsed) + +deriving stock instance Ord (RecordUpdateField 'Scoped) + +data RecordField (s :: Stage) = RecordField + { _fieldName :: SymbolType s, + _fieldColon :: Irrelevant (KeywordRef), + _fieldType :: ExpressionType s, + _fieldBuiltin :: Maybe (WithLoc BuiltinFunction), + _fieldDoc :: Maybe (Judoc s), + _fieldPragmas :: Maybe ParsedPragmas + } + deriving stock (Generic) + +instance Serialize (RecordField 'Scoped) + +instance NFData (RecordField 'Scoped) + +deriving stock instance Show (RecordField 'Parsed) + +deriving stock instance Show (RecordField 'Scoped) + +deriving stock instance Eq (RecordField 'Parsed) + +deriving stock instance Eq (RecordField 'Scoped) + +deriving stock instance Ord (RecordField 'Parsed) + +deriving stock instance Ord (RecordField 'Scoped) + +newtype RhsAdt (s :: Stage) = RhsAdt + { _rhsAdtArguments :: [ExpressionType s] + } + deriving stock (Generic) + +instance Serialize (RhsAdt 'Scoped) + +instance NFData (RhsAdt 'Scoped) + +deriving stock instance Show (RhsAdt 'Parsed) + +deriving stock instance Show (RhsAdt 'Scoped) + +deriving stock instance Eq (RhsAdt 'Parsed) + +deriving stock instance Eq (RhsAdt 'Scoped) + +deriving stock instance Ord (RhsAdt 'Parsed) + +deriving stock instance Ord (RhsAdt 'Scoped) + +data RhsRecord (s :: Stage) = RhsRecord + { _rhsRecordDelim :: Irrelevant (KeywordRef, KeywordRef), + _rhsRecordStatements :: [RecordStatement s] + } + deriving stock (Generic) + +instance Serialize (RhsRecord 'Scoped) + +instance NFData (RhsRecord 'Scoped) + +deriving stock instance Show (RhsRecord 'Parsed) + +deriving stock instance Show (RhsRecord 'Scoped) + +deriving stock instance Eq (RhsRecord 'Parsed) + +deriving stock instance Eq (RhsRecord 'Scoped) + +deriving stock instance Ord (RhsRecord 'Parsed) + +deriving stock instance Ord (RhsRecord 'Scoped) + +data RhsGadt (s :: Stage) = RhsGadt + { _rhsGadtColon :: Irrelevant KeywordRef, + _rhsGadtType :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (RhsGadt 'Scoped) + +instance NFData (RhsGadt 'Scoped) + +deriving stock instance Show (RhsGadt 'Parsed) + +deriving stock instance Show (RhsGadt 'Scoped) + +deriving stock instance Eq (RhsGadt 'Parsed) + +deriving stock instance Eq (RhsGadt 'Scoped) + +deriving stock instance Ord (RhsGadt 'Parsed) + +deriving stock instance Ord (RhsGadt 'Scoped) + +data ConstructorRhs (s :: Stage) + = ConstructorRhsGadt (RhsGadt s) + | ConstructorRhsRecord (RhsRecord s) + | ConstructorRhsAdt (RhsAdt s) + deriving stock (Generic) + +instance Serialize (ConstructorRhs 'Scoped) + +instance NFData (ConstructorRhs 'Scoped) + +deriving stock instance Show (ConstructorRhs 'Parsed) + +deriving stock instance Show (ConstructorRhs 'Scoped) + +deriving stock instance Eq (ConstructorRhs 'Parsed) + +deriving stock instance Eq (ConstructorRhs 'Scoped) + +deriving stock instance Ord (ConstructorRhs 'Parsed) + +deriving stock instance Ord (ConstructorRhs 'Scoped) + +data InductiveParametersRhs (s :: Stage) = InductiveParametersRhs + { _inductiveParametersColon :: Irrelevant KeywordRef, + _inductiveParametersType :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (InductiveParametersRhs 'Scoped) + +instance NFData (InductiveParametersRhs 'Scoped) + +deriving stock instance Show (InductiveParametersRhs 'Parsed) + +deriving stock instance Show (InductiveParametersRhs 'Scoped) + +deriving stock instance Eq (InductiveParametersRhs 'Parsed) + +deriving stock instance Eq (InductiveParametersRhs 'Scoped) + +deriving stock instance Ord (InductiveParametersRhs 'Parsed) + +deriving stock instance Ord (InductiveParametersRhs 'Scoped) + +data InductiveParameters (s :: Stage) = InductiveParameters + { _inductiveParametersNames :: NonEmpty (SymbolType s), + _inductiveParametersRhs :: Maybe (InductiveParametersRhs s) + } + deriving stock (Generic) + +instance Serialize (InductiveParameters 'Scoped) + +instance NFData (InductiveParameters 'Scoped) + +deriving stock instance Show (InductiveParameters 'Parsed) + +deriving stock instance Show (InductiveParameters 'Scoped) + +deriving stock instance Eq (InductiveParameters 'Parsed) + +deriving stock instance Eq (InductiveParameters 'Scoped) + +deriving stock instance Ord (InductiveParameters 'Parsed) + +deriving stock instance Ord (InductiveParameters 'Scoped) + +data InductiveDef (s :: Stage) = InductiveDef + { _inductiveKw :: Irrelevant KeywordRef, + _inductiveAssignKw :: Irrelevant KeywordRef, + _inductiveBuiltin :: Maybe (WithLoc BuiltinInductive), + _inductiveDoc :: Maybe (Judoc s), + _inductivePragmas :: Maybe ParsedPragmas, + _inductiveName :: InductiveName s, + _inductiveParameters :: [InductiveParameters s], + _inductiveType :: Maybe (ExpressionType s), + _inductiveConstructors :: NonEmpty (ConstructorDef s), + _inductivePositive :: Maybe KeywordRef, + _inductiveTrait :: Maybe KeywordRef + } + deriving stock (Generic) + +instance Serialize (InductiveDef 'Scoped) + +instance NFData (InductiveDef 'Scoped) + +deriving stock instance Show (InductiveDef 'Parsed) + +deriving stock instance Show (InductiveDef 'Scoped) + +deriving stock instance Eq (InductiveDef 'Parsed) + +deriving stock instance Eq (InductiveDef 'Scoped) + +deriving stock instance Ord (InductiveDef 'Parsed) + +deriving stock instance Ord (InductiveDef 'Scoped) + +data PatternApp = PatternApp + { _patAppLeft :: PatternArg, + _patAppRight :: PatternArg + } + deriving stock (Show, Eq, Ord, Generic) + +instance Serialize PatternApp + +instance NFData PatternApp + +data PatternInfixApp = PatternInfixApp + { _patInfixLeft :: PatternArg, + _patInfixConstructor :: ScopedIden, + _patInfixRight :: PatternArg + } + deriving stock (Show, Eq, Ord, Generic) + +instance Serialize PatternInfixApp + +instance NFData PatternInfixApp + +data PatternPostfixApp = PatternPostfixApp + { _patPostfixParameter :: PatternArg, + _patPostfixConstructor :: ScopedIden + } + deriving stock (Show, Eq, Ord, Generic) + +instance Serialize PatternPostfixApp + +instance NFData PatternPostfixApp + +data PatternArg = PatternArg + { _patternArgIsImplicit :: IsImplicit, + _patternArgName :: Maybe S.Symbol, + _patternArgPattern :: Pattern + } + deriving stock (Show, Eq, Ord, Generic) + +instance Serialize PatternArg + +instance NFData PatternArg + +data Pattern + = PatternVariable (SymbolType 'Scoped) + | PatternConstructor ScopedIden + | PatternWildcardConstructor (WildcardConstructor 'Scoped) + | PatternApplication PatternApp + | PatternList (ListPattern 'Scoped) + | PatternInfixApplication PatternInfixApp + | PatternPostfixApplication PatternPostfixApp + | PatternWildcard Wildcard + | PatternEmpty Interval + | PatternRecord (RecordPattern 'Scoped) + deriving stock (Show, Eq, Ord, Generic) + +instance Serialize Pattern + +instance NFData Pattern + +data PatternScopedIden + = PatternScopedVar S.Symbol + | PatternScopedConstructor ScopedIden + deriving stock (Show, Ord, Eq) + +data PatternBinding = PatternBinding + { _patternBindingName :: Symbol, + _patternBindingAtKw :: Irrelevant KeywordRef, + _patternBindingPattern :: PatternAtom 'Parsed + } + deriving stock (Ord, Eq, Show, Generic) + +instance Serialize PatternBinding + +instance NFData PatternBinding + +data ListPattern (s :: Stage) = ListPattern + { _listpBracketL :: Irrelevant KeywordRef, + _listpBracketR :: Irrelevant KeywordRef, + _listpItems :: [PatternParensType s] + } + deriving stock (Generic) + +instance Serialize (ListPattern 'Scoped) + +instance NFData (ListPattern 'Scoped) + +instance Serialize (ListPattern 'Parsed) + +instance NFData (ListPattern 'Parsed) + +deriving stock instance Show (ListPattern 'Parsed) + +deriving stock instance Show (ListPattern 'Scoped) + +deriving stock instance Eq (ListPattern 'Parsed) + +deriving stock instance Eq (ListPattern 'Scoped) + +deriving stock instance Ord (ListPattern 'Parsed) + +deriving stock instance Ord (ListPattern 'Scoped) + +data RecordPatternAssign (s :: Stage) = RecordPatternAssign + { _recordPatternAssignKw :: Irrelevant KeywordRef, + _recordPatternAssignField :: Symbol, + _recordPatternAssignFieldIx :: FieldArgIxType s, + _recordPatternAssignPattern :: PatternParensType s + } + deriving stock (Generic) + +instance Serialize (RecordPatternAssign 'Scoped) + +instance NFData (RecordPatternAssign 'Scoped) + +instance Serialize (RecordPatternAssign 'Parsed) + +instance NFData (RecordPatternAssign 'Parsed) + +deriving stock instance Show (RecordPatternAssign 'Parsed) + +deriving stock instance Show (RecordPatternAssign 'Scoped) + +deriving stock instance Eq (RecordPatternAssign 'Parsed) + +deriving stock instance Eq (RecordPatternAssign 'Scoped) + +deriving stock instance Ord (RecordPatternAssign 'Parsed) + +deriving stock instance Ord (RecordPatternAssign 'Scoped) + +data FieldPun (s :: Stage) = FieldPun + { _fieldPunIx :: FieldArgIxType s, + _fieldPunField :: SymbolType s + } + deriving stock (Generic) + +instance Serialize (FieldPun 'Scoped) + +instance NFData (FieldPun 'Scoped) + +instance Serialize (FieldPun 'Parsed) + +instance NFData (FieldPun 'Parsed) + +deriving stock instance Show (FieldPun 'Parsed) + +deriving stock instance Show (FieldPun 'Scoped) + +deriving stock instance Eq (FieldPun 'Parsed) + +deriving stock instance Eq (FieldPun 'Scoped) + +deriving stock instance Ord (FieldPun 'Parsed) + +deriving stock instance Ord (FieldPun 'Scoped) + +data RecordPatternItem (s :: Stage) + = RecordPatternItemFieldPun (FieldPun s) + | RecordPatternItemAssign (RecordPatternAssign s) + deriving stock (Generic) + +instance Serialize (RecordPatternItem 'Scoped) + +instance NFData (RecordPatternItem 'Scoped) + +instance Serialize (RecordPatternItem 'Parsed) + +instance NFData (RecordPatternItem 'Parsed) + +deriving stock instance Show (RecordPatternItem 'Parsed) + +deriving stock instance Show (RecordPatternItem 'Scoped) + +deriving stock instance Eq (RecordPatternItem 'Parsed) + +deriving stock instance Eq (RecordPatternItem 'Scoped) + +deriving stock instance Ord (RecordPatternItem 'Parsed) + +deriving stock instance Ord (RecordPatternItem 'Scoped) + +data RecordPattern (s :: Stage) = RecordPattern + { _recordPatternConstructor :: IdentifierType s, + _recordPatternItems :: [RecordPatternItem s] + } + deriving stock (Generic) + +instance Serialize (RecordPattern 'Scoped) + +instance NFData (RecordPattern 'Scoped) + +instance Serialize (RecordPattern 'Parsed) + +instance NFData (RecordPattern 'Parsed) + +deriving stock instance Show (RecordPattern 'Parsed) + +deriving stock instance Show (RecordPattern 'Scoped) + +deriving stock instance Eq (RecordPattern 'Parsed) + +deriving stock instance Eq (RecordPattern 'Scoped) + +deriving stock instance Ord (RecordPattern 'Parsed) + +deriving stock instance Ord (RecordPattern 'Scoped) + +data WildcardConstructor (s :: Stage) = WildcardConstructor + { _wildcardConstructor :: IdentifierType s, + _wildcardConstructorAtKw :: Irrelevant KeywordRef, + _wildcardConstructorDelims :: Irrelevant (KeywordRef, KeywordRef) + } + deriving stock (Generic) + +instance Serialize (WildcardConstructor 'Scoped) + +instance NFData (WildcardConstructor 'Scoped) + +instance Serialize (WildcardConstructor 'Parsed) + +instance NFData (WildcardConstructor 'Parsed) + +deriving stock instance Show (WildcardConstructor 'Parsed) + +deriving stock instance Show (WildcardConstructor 'Scoped) + +deriving stock instance Eq (WildcardConstructor 'Parsed) + +deriving stock instance Eq (WildcardConstructor 'Scoped) + +deriving stock instance Ord (WildcardConstructor 'Parsed) + +deriving stock instance Ord (WildcardConstructor 'Scoped) + +data PatternAtom (s :: Stage) + = PatternAtomIden (PatternAtomIdenType s) + | PatternAtomWildcard Wildcard + | PatternAtomEmpty Interval + | PatternAtomList (ListPattern s) + | PatternAtomWildcardConstructor (WildcardConstructor s) + | PatternAtomRecord (RecordPattern s) + | PatternAtomParens (PatternParensType s) + | PatternAtomBraces (PatternParensType s) + | PatternAtomDoubleBraces (PatternParensType s) + | PatternAtomAt (PatternAtType s) + deriving stock (Generic) + +instance Serialize (PatternAtom 'Parsed) + +instance NFData (PatternAtom 'Parsed) + +deriving stock instance Show (PatternAtom 'Parsed) + +deriving stock instance Show (PatternAtom 'Scoped) + +deriving stock instance Eq (PatternAtom 'Parsed) + +deriving stock instance Eq (PatternAtom 'Scoped) + +deriving stock instance Ord (PatternAtom 'Parsed) + +deriving stock instance Ord (PatternAtom 'Scoped) + +data PatternAtoms (s :: Stage) = PatternAtoms + { _patternAtoms :: NonEmpty (PatternAtom s), + _patternAtomsLoc :: Irrelevant Interval + } + deriving stock (Generic) + +instance Serialize (PatternAtoms 'Parsed) + +instance NFData (PatternAtoms 'Parsed) + +deriving stock instance Show (PatternAtoms 'Parsed) + +deriving stock instance Show (PatternAtoms 'Scoped) + +deriving stock instance Eq (PatternAtoms 'Parsed) + +deriving stock instance Eq (PatternAtoms 'Scoped) + +deriving stock instance Ord (PatternAtoms 'Parsed) + +deriving stock instance Ord (PatternAtoms 'Scoped) + +type FunctionName s = SymbolType s + +type LocalModuleName s = SymbolType s + +data MarkdownInfo = MarkdownInfo + { _markdownInfo :: Mk, + _markdownInfoBlockLengths :: [Int] + } + deriving stock (Show, Eq, Ord) + +data Module (s :: Stage) (t :: ModuleIsTop) = Module + { _moduleKw :: KeywordRef, + _modulePath :: ModulePathType s t, + _moduleDoc :: Maybe (Judoc s), + _modulePragmas :: Maybe ParsedPragmas, + _moduleBody :: [Statement s], + _moduleKwEnd :: ModuleEndType t, + _moduleOrigin :: ModuleInductiveType t, + _moduleId :: ModuleIdType s t, + _moduleMarkdownInfo :: Maybe MarkdownInfo + } + +deriving stock instance Show (Module 'Parsed 'ModuleTop) + +deriving stock instance Show (Module 'Scoped 'ModuleTop) + +deriving stock instance Show (Module 'Parsed 'ModuleLocal) + +deriving stock instance Show (Module 'Scoped 'ModuleLocal) + +deriving stock instance Eq (Module 'Parsed 'ModuleTop) + +deriving stock instance Eq (Module 'Scoped 'ModuleTop) + +deriving stock instance Eq (Module 'Parsed 'ModuleLocal) + +deriving stock instance Eq (Module 'Scoped 'ModuleLocal) + +deriving stock instance Ord (Module 'Parsed 'ModuleTop) + +deriving stock instance Ord (Module 'Scoped 'ModuleTop) + +deriving stock instance Ord (Module 'Parsed 'ModuleLocal) + +deriving stock instance Ord (Module 'Scoped 'ModuleLocal) + +data HidingItem (s :: Stage) = HidingItem + { _hidingSymbol :: SymbolType s, + _hidingModuleKw :: Maybe KeywordRef + } + deriving stock (Generic) + +instance Serialize (HidingItem 'Scoped) + +instance NFData (HidingItem 'Scoped) + +instance Serialize (HidingItem 'Parsed) + +instance NFData (HidingItem 'Parsed) + +deriving stock instance Show (HidingItem 'Parsed) + +deriving stock instance Show (HidingItem 'Scoped) + +deriving stock instance Eq (HidingItem 'Parsed) + +deriving stock instance Eq (HidingItem 'Scoped) + +deriving stock instance Ord (HidingItem 'Parsed) + +deriving stock instance Ord (HidingItem 'Scoped) + +data UsingItem (s :: Stage) = UsingItem + { _usingSymbol :: SymbolType s, + _usingModuleKw :: Maybe KeywordRef, + _usingAsKw :: Irrelevant (Maybe KeywordRef), + _usingAs :: Maybe (SymbolType s) + } + deriving stock (Generic) + +instance Serialize (UsingItem 'Scoped) + +instance NFData (UsingItem 'Scoped) + +instance Serialize (UsingItem 'Parsed) + +instance NFData (UsingItem 'Parsed) + +deriving stock instance Show (UsingItem 'Parsed) + +deriving stock instance Show (UsingItem 'Scoped) + +deriving stock instance Eq (UsingItem 'Parsed) + +deriving stock instance Eq (UsingItem 'Scoped) + +deriving stock instance Ord (UsingItem 'Parsed) + +deriving stock instance Ord (UsingItem 'Scoped) + +data UsingList (s :: Stage) = UsingList + { _usingKw :: Irrelevant KeywordRef, + _usingBraces :: Irrelevant (KeywordRef, KeywordRef), + _usingList :: NonEmpty (UsingItem s) + } + deriving stock (Generic) + +instance Serialize (UsingList 'Scoped) + +instance NFData (UsingList 'Scoped) + +instance Serialize (UsingList 'Parsed) + +instance NFData (UsingList 'Parsed) + +deriving stock instance Show (UsingList 'Parsed) + +deriving stock instance Show (UsingList 'Scoped) + +deriving stock instance Eq (UsingList 'Parsed) + +deriving stock instance Eq (UsingList 'Scoped) + +deriving stock instance Ord (UsingList 'Parsed) + +deriving stock instance Ord (UsingList 'Scoped) + +data HidingList (s :: Stage) = HidingList + { _hidingKw :: Irrelevant KeywordRef, + _hidingBraces :: Irrelevant (KeywordRef, KeywordRef), + _hidingList :: NonEmpty (HidingItem s) + } + deriving stock (Generic) + +instance Serialize (HidingList 'Scoped) + +instance NFData (HidingList 'Scoped) + +instance Serialize (HidingList 'Parsed) + +instance NFData (HidingList 'Parsed) + +deriving stock instance Show (HidingList 'Parsed) + +deriving stock instance Show (HidingList 'Scoped) + +deriving stock instance Eq (HidingList 'Parsed) + +deriving stock instance Eq (HidingList 'Scoped) + +deriving stock instance Ord (HidingList 'Parsed) + +deriving stock instance Ord (HidingList 'Scoped) + +data UsingHiding (s :: Stage) + = Using (UsingList s) + | Hiding (HidingList s) + deriving stock (Generic) + +instance Serialize (UsingHiding 'Scoped) + +instance NFData (UsingHiding 'Scoped) + +instance Serialize (UsingHiding 'Parsed) + +instance NFData (UsingHiding 'Parsed) + +deriving stock instance Show (UsingHiding 'Parsed) + +deriving stock instance Show (UsingHiding 'Scoped) + +deriving stock instance Eq (UsingHiding 'Parsed) + +deriving stock instance Eq (UsingHiding 'Scoped) + +deriving stock instance Ord (UsingHiding 'Parsed) + +deriving stock instance Ord (UsingHiding 'Scoped) + +getNameRefId :: forall c. (SingI c) => RefNameType c -> S.NameId +getNameRefId = case sing :: S.SIsConcrete c of + S.SConcrete -> (^. S.nameId) + S.SNotConcrete -> (^. S.nameId) + +data OpenModule (s :: Stage) (short :: IsOpenShort) = OpenModule + { _openModuleKw :: KeywordRef, + _openModuleName :: OpenModuleNameType s short, + _openModuleUsingHiding :: Maybe (UsingHiding s), + _openModulePublic :: PublicAnn + } + deriving stock (Generic) + +instance Serialize (OpenModule 'Scoped 'OpenFull) + +instance Serialize (OpenModule 'Scoped 'OpenShort) + +instance NFData (OpenModule 'Scoped 'OpenFull) + +instance NFData (OpenModule 'Scoped 'OpenShort) + +instance Serialize (OpenModule 'Parsed 'OpenFull) + +instance Serialize (OpenModule 'Parsed 'OpenShort) + +instance NFData (OpenModule 'Parsed 'OpenShort) + +instance NFData (OpenModule 'Parsed 'OpenFull) + +deriving stock instance Show (OpenModule 'Parsed 'OpenShort) + +deriving stock instance Show (OpenModule 'Parsed 'OpenFull) + +deriving stock instance Show (OpenModule 'Scoped 'OpenShort) + +deriving stock instance Show (OpenModule 'Scoped 'OpenFull) + +deriving stock instance Eq (OpenModule 'Parsed 'OpenShort) + +deriving stock instance Eq (OpenModule 'Parsed 'OpenFull) + +deriving stock instance Eq (OpenModule 'Scoped 'OpenShort) + +deriving stock instance Eq (OpenModule 'Scoped 'OpenFull) + +deriving stock instance Ord (OpenModule 'Parsed 'OpenShort) + +deriving stock instance Ord (OpenModule 'Parsed 'OpenFull) + +deriving stock instance Ord (OpenModule 'Scoped 'OpenShort) + +deriving stock instance Ord (OpenModule 'Scoped 'OpenFull) + +data ScopedIden = ScopedIden + { _scopedIdenFinal :: S.Name, + _scopedIdenAlias :: Maybe S.Name + } + deriving stock (Show, Eq, Ord, Generic) + +instance Serialize ScopedIden + +instance NFData ScopedIden + +data Expression + = ExpressionIdentifier ScopedIden + | ExpressionParensIdentifier ScopedIden + | ExpressionApplication Application + | ExpressionInfixApplication InfixApplication + | ExpressionPostfixApplication PostfixApplication + | ExpressionList (List 'Scoped) + | ExpressionCase (Case 'Scoped) + | ExpressionIf (If 'Scoped) + | ExpressionLambda (Lambda 'Scoped) + | ExpressionLet (Let 'Scoped) + | ExpressionUniverse Universe + | ExpressionLiteral LiteralLoc + | ExpressionFunction (Function 'Scoped) + | ExpressionHole (HoleType 'Scoped) + | ExpressionInstanceHole (HoleType 'Scoped) + | ExpressionRecordUpdate RecordUpdateApp + | ExpressionParensRecordUpdate ParensRecordUpdate + | ExpressionBraces (WithLoc Expression) + | ExpressionDoubleBraces (DoubleBracesExpression 'Scoped) + | ExpressionIterator (Iterator 'Scoped) + | ExpressionNamedApplication (NamedApplication 'Scoped) + | ExpressionNamedApplicationNew (NamedApplicationNew 'Scoped) + deriving stock (Show, Eq, Ord, Generic) + +instance Serialize Expression + +instance NFData Expression + +data DoubleBracesExpression (s :: Stage) = DoubleBracesExpression + { _doubleBracesExpression :: ExpressionType s, + _doubleBracesDelims :: Irrelevant (KeywordRef, KeywordRef) + } + deriving stock (Generic) + +instance Serialize (DoubleBracesExpression 'Scoped) + +instance NFData (DoubleBracesExpression 'Scoped) + +instance Serialize (DoubleBracesExpression 'Parsed) + +instance NFData (DoubleBracesExpression 'Parsed) + +deriving stock instance Show (DoubleBracesExpression 'Parsed) + +deriving stock instance Show (DoubleBracesExpression 'Scoped) + +deriving stock instance Eq (DoubleBracesExpression 'Parsed) + +deriving stock instance Eq (DoubleBracesExpression 'Scoped) + +deriving stock instance Ord (DoubleBracesExpression 'Parsed) + +deriving stock instance Ord (DoubleBracesExpression 'Scoped) + +instance HasAtomicity (Lambda s) where + atomicity = const Atom + +data FunctionParameter (s :: Stage) + = FunctionParameterName (SymbolType s) + | FunctionParameterWildcard KeywordRef + deriving stock (Generic) + +instance Serialize (FunctionParameter 'Scoped) + +instance NFData (FunctionParameter 'Scoped) + +instance Serialize (FunctionParameter 'Parsed) + +instance NFData (FunctionParameter 'Parsed) + +deriving stock instance Show (FunctionParameter 'Parsed) + +deriving stock instance Show (FunctionParameter 'Scoped) + +deriving stock instance Eq (FunctionParameter 'Parsed) + +deriving stock instance Eq (FunctionParameter 'Scoped) + +deriving stock instance Ord (FunctionParameter 'Parsed) + +deriving stock instance Ord (FunctionParameter 'Scoped) + +data FunctionParameters (s :: Stage) = FunctionParameters + { _paramNames :: [FunctionParameter s], + _paramImplicit :: IsImplicit, + _paramDelims :: Delims, + _paramColon :: Irrelevant (Maybe KeywordRef), + _paramType :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (FunctionParameters 'Scoped) + +instance NFData (FunctionParameters 'Scoped) + +instance Serialize (FunctionParameters 'Parsed) + +instance NFData (FunctionParameters 'Parsed) + +deriving stock instance Show (FunctionParameters 'Parsed) + +deriving stock instance Show (FunctionParameters 'Scoped) + +deriving stock instance Eq (FunctionParameters 'Parsed) + +deriving stock instance Eq (FunctionParameters 'Scoped) + +deriving stock instance Ord (FunctionParameters 'Parsed) + +deriving stock instance Ord (FunctionParameters 'Scoped) + +-- | Function *type* representation +data Function (s :: Stage) = Function + { _funParameters :: FunctionParameters s, + _funKw :: KeywordRef, + _funReturn :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (Function 'Scoped) + +instance NFData (Function 'Scoped) + +instance Serialize (Function 'Parsed) + +instance NFData (Function 'Parsed) + +deriving stock instance Show (Function 'Parsed) + +deriving stock instance Show (Function 'Scoped) + +deriving stock instance Eq (Function 'Parsed) + +deriving stock instance Eq (Function 'Scoped) + +deriving stock instance Ord (Function 'Parsed) + +deriving stock instance Ord (Function 'Scoped) + +data Lambda (s :: Stage) = Lambda + { _lambdaKw :: KeywordRef, + _lambdaBraces :: Irrelevant (KeywordRef, KeywordRef), + _lambdaClauses :: NonEmpty (LambdaClause s) + } + deriving stock (Generic) + +instance Serialize (Lambda 'Scoped) + +instance NFData (Lambda 'Scoped) + +instance Serialize (Lambda 'Parsed) + +instance NFData (Lambda 'Parsed) + +deriving stock instance Show (Lambda 'Parsed) + +deriving stock instance Show (Lambda 'Scoped) + +deriving stock instance Eq (Lambda 'Parsed) + +deriving stock instance Eq (Lambda 'Scoped) + +deriving stock instance Ord (Lambda 'Parsed) + +deriving stock instance Ord (Lambda 'Scoped) + +data LambdaClause (s :: Stage) = LambdaClause + { _lambdaPipe :: Irrelevant (Maybe KeywordRef), + _lambdaParameters :: NonEmpty (PatternAtomType s), + _lambdaAssignKw :: Irrelevant KeywordRef, + _lambdaBody :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (LambdaClause 'Scoped) + +instance NFData (LambdaClause 'Scoped) + +instance Serialize (LambdaClause 'Parsed) + +instance NFData (LambdaClause 'Parsed) + +deriving stock instance Show (LambdaClause 'Parsed) + +deriving stock instance Show (LambdaClause 'Scoped) + +deriving stock instance Eq (LambdaClause 'Parsed) + +deriving stock instance Eq (LambdaClause 'Scoped) + +deriving stock instance Ord (LambdaClause 'Parsed) + +deriving stock instance Ord (LambdaClause 'Scoped) + +data Application = Application + { _applicationFunction :: Expression, + _applicationParameter :: Expression + } + deriving stock (Show, Eq, Ord, Generic) + +instance Serialize Application + +instance NFData Application + +data InfixApplication = InfixApplication + { _infixAppLeft :: Expression, + _infixAppOperator :: ScopedIden, + _infixAppRight :: Expression + } + deriving stock (Show, Eq, Ord, Generic) + +instance Serialize InfixApplication + +instance NFData InfixApplication + +data PostfixApplication = PostfixApplication + { _postfixAppParameter :: Expression, + _postfixAppOperator :: ScopedIden + } + deriving stock (Show, Eq, Ord, Generic) + +instance Serialize PostfixApplication + +instance NFData PostfixApplication + +data LetStatement (s :: Stage) + = LetFunctionDef (FunctionDef s) + | LetAliasDef (AliasDef s) + | LetOpen (OpenModule s 'OpenFull) + deriving stock (Generic) + +instance Serialize (LetStatement 'Scoped) + +instance NFData (LetStatement 'Scoped) + +instance Serialize (LetStatement 'Parsed) + +instance NFData (LetStatement 'Parsed) + +deriving stock instance Show (LetStatement 'Parsed) + +deriving stock instance Show (LetStatement 'Scoped) + +deriving stock instance Eq (LetStatement 'Parsed) + +deriving stock instance Eq (LetStatement 'Scoped) + +deriving stock instance Ord (LetStatement 'Parsed) + +deriving stock instance Ord (LetStatement 'Scoped) + +data Let (s :: Stage) = Let + { _letKw :: KeywordRef, + _letInKw :: Irrelevant KeywordRef, + _letFunDefs :: NonEmpty (LetStatement s), + _letExpression :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (Let 'Scoped) + +instance NFData (Let 'Scoped) + +instance Serialize (Let 'Parsed) + +instance NFData (Let 'Parsed) + +deriving stock instance Show (Let 'Parsed) + +deriving stock instance Show (Let 'Scoped) + +deriving stock instance Eq (Let 'Parsed) + +deriving stock instance Eq (Let 'Scoped) + +deriving stock instance Ord (Let 'Parsed) + +deriving stock instance Ord (Let 'Scoped) + +data SideIfBranch (s :: Stage) (k :: IfBranchKind) = SideIfBranch + { _sideIfBranchPipe :: Irrelevant (Maybe KeywordRef), + _sideIfBranchKw :: Irrelevant KeywordRef, + _sideIfBranchCondition :: SideIfBranchConditionType s k, + _sideIfBranchAssignKw :: Irrelevant KeywordRef, + _sideIfBranchBody :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (SideIfBranch 'Scoped 'BranchIfBool) + +instance Serialize (SideIfBranch 'Scoped 'BranchIfElse) + +instance NFData (SideIfBranch 'Scoped 'BranchIfBool) + +instance NFData (SideIfBranch 'Scoped 'BranchIfElse) + +instance Serialize (SideIfBranch 'Parsed 'BranchIfBool) + +instance Serialize (SideIfBranch 'Parsed 'BranchIfElse) + +instance NFData (SideIfBranch 'Parsed 'BranchIfElse) + +instance NFData (SideIfBranch 'Parsed 'BranchIfBool) + +deriving stock instance Show (SideIfBranch 'Parsed 'BranchIfElse) + +deriving stock instance Show (SideIfBranch 'Parsed 'BranchIfBool) + +deriving stock instance Show (SideIfBranch 'Scoped 'BranchIfElse) + +deriving stock instance Show (SideIfBranch 'Scoped 'BranchIfBool) + +deriving stock instance Eq (SideIfBranch 'Parsed 'BranchIfElse) + +deriving stock instance Eq (SideIfBranch 'Parsed 'BranchIfBool) + +deriving stock instance Eq (SideIfBranch 'Scoped 'BranchIfElse) + +deriving stock instance Eq (SideIfBranch 'Scoped 'BranchIfBool) + +deriving stock instance Ord (SideIfBranch 'Parsed 'BranchIfElse) + +deriving stock instance Ord (SideIfBranch 'Parsed 'BranchIfBool) + +deriving stock instance Ord (SideIfBranch 'Scoped 'BranchIfElse) + +deriving stock instance Ord (SideIfBranch 'Scoped 'BranchIfBool) + +data SideIfs (s :: Stage) = SideIfs + { _sideIfBranches :: NonEmpty (SideIfBranch s 'BranchIfBool), + _sideIfElse :: Maybe (SideIfBranch s 'BranchIfElse) + } + deriving stock (Generic) + +instance Serialize (SideIfs 'Scoped) + +instance NFData (SideIfs 'Scoped) + +instance Serialize (SideIfs 'Parsed) + +instance NFData (SideIfs 'Parsed) + +deriving stock instance Show (SideIfs 'Parsed) + +deriving stock instance Show (SideIfs 'Scoped) + +deriving stock instance Eq (SideIfs 'Parsed) + +deriving stock instance Eq (SideIfs 'Scoped) + +deriving stock instance Ord (SideIfs 'Parsed) + +deriving stock instance Ord (SideIfs 'Scoped) + +data RhsExpression (s :: Stage) = RhsExpression + { _rhsExpressionAssignKw :: Irrelevant KeywordRef, + _rhsExpression :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (RhsExpression 'Scoped) + +instance NFData (RhsExpression 'Scoped) + +instance Serialize (RhsExpression 'Parsed) + +instance NFData (RhsExpression 'Parsed) + +deriving stock instance Show (RhsExpression 'Parsed) + +deriving stock instance Show (RhsExpression 'Scoped) + +deriving stock instance Eq (RhsExpression 'Parsed) + +deriving stock instance Eq (RhsExpression 'Scoped) + +deriving stock instance Ord (RhsExpression 'Parsed) + +deriving stock instance Ord (RhsExpression 'Scoped) + +data CaseBranchRhs (s :: Stage) + = CaseBranchRhsExpression (RhsExpression s) + | CaseBranchRhsIf (SideIfs s) + deriving stock (Generic) + +instance Serialize (CaseBranchRhs 'Scoped) + +instance NFData (CaseBranchRhs 'Scoped) + +instance Serialize (CaseBranchRhs 'Parsed) + +instance NFData (CaseBranchRhs 'Parsed) + +deriving stock instance Show (CaseBranchRhs 'Parsed) + +deriving stock instance Show (CaseBranchRhs 'Scoped) + +deriving stock instance Eq (CaseBranchRhs 'Parsed) + +deriving stock instance Eq (CaseBranchRhs 'Scoped) + +deriving stock instance Ord (CaseBranchRhs 'Parsed) + +deriving stock instance Ord (CaseBranchRhs 'Scoped) + +data CaseBranch (s :: Stage) = CaseBranch + { _caseBranchPipe :: Irrelevant (Maybe KeywordRef), + _caseBranchPattern :: PatternParensType s, + _caseBranchRhs :: CaseBranchRhs s + } + deriving stock (Generic) + +instance Serialize (CaseBranch 'Scoped) + +instance NFData (CaseBranch 'Scoped) + +instance Serialize (CaseBranch 'Parsed) + +instance NFData (CaseBranch 'Parsed) + +deriving stock instance Show (CaseBranch 'Parsed) + +deriving stock instance Show (CaseBranch 'Scoped) + +deriving stock instance Eq (CaseBranch 'Parsed) + +deriving stock instance Eq (CaseBranch 'Scoped) + +deriving stock instance Ord (CaseBranch 'Parsed) + +deriving stock instance Ord (CaseBranch 'Scoped) + +data Case (s :: Stage) = Case + { _caseKw :: KeywordRef, + _caseOfKw :: KeywordRef, + _caseExpression :: ExpressionType s, + _caseBranches :: NonEmpty (CaseBranch s) + } + deriving stock (Generic) + +instance Serialize (Case 'Scoped) + +instance NFData (Case 'Scoped) + +instance Serialize (Case 'Parsed) + +instance NFData (Case 'Parsed) + +deriving stock instance Show (Case 'Parsed) + +deriving stock instance Show (Case 'Scoped) + +deriving stock instance Eq (Case 'Parsed) + +deriving stock instance Eq (Case 'Scoped) + +deriving stock instance Ord (Case 'Parsed) + +deriving stock instance Ord (Case 'Scoped) + +data NewCaseBranch (s :: Stage) = NewCaseBranch + { _newCaseBranchPipe :: Irrelevant (Maybe KeywordRef), + _newCaseBranchAssignKw :: Irrelevant KeywordRef, + _newCaseBranchPattern :: PatternParensType s, + _newCaseBranchExpression :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (NewCaseBranch 'Scoped) + +instance NFData (NewCaseBranch 'Scoped) + +instance Serialize (NewCaseBranch 'Parsed) + +instance NFData (NewCaseBranch 'Parsed) + +deriving stock instance Show (NewCaseBranch 'Parsed) + +deriving stock instance Show (NewCaseBranch 'Scoped) + +deriving stock instance Eq (NewCaseBranch 'Parsed) + +deriving stock instance Eq (NewCaseBranch 'Scoped) + +deriving stock instance Ord (NewCaseBranch 'Parsed) + +deriving stock instance Ord (NewCaseBranch 'Scoped) + +data NewCase (s :: Stage) = NewCase + { _newCaseKw :: KeywordRef, + _newCaseOfKw :: KeywordRef, + _newCaseExpression :: ExpressionType s, + _newCaseBranches :: NonEmpty (NewCaseBranch s) + } + deriving stock (Generic) + +instance Serialize (NewCase 'Scoped) + +instance NFData (NewCase 'Scoped) + +instance Serialize (NewCase 'Parsed) + +instance NFData (NewCase 'Parsed) + +deriving stock instance Show (NewCase 'Parsed) + +deriving stock instance Show (NewCase 'Scoped) + +deriving stock instance Eq (NewCase 'Parsed) + +deriving stock instance Eq (NewCase 'Scoped) + +deriving stock instance Ord (NewCase 'Parsed) + +deriving stock instance Ord (NewCase 'Scoped) + +data IfBranch (s :: Stage) (k :: IfBranchKind) = IfBranch + { _ifBranchPipe :: Irrelevant KeywordRef, + _ifBranchAssignKw :: Irrelevant KeywordRef, + _ifBranchCondition :: IfBranchConditionType s k, + _ifBranchExpression :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (IfBranch 'Scoped 'BranchIfBool) + +instance Serialize (IfBranch 'Scoped 'BranchIfElse) + +instance NFData (IfBranch 'Scoped 'BranchIfBool) + +instance NFData (IfBranch 'Scoped 'BranchIfElse) + +instance Serialize (IfBranch 'Parsed 'BranchIfBool) + +instance Serialize (IfBranch 'Parsed 'BranchIfElse) + +instance NFData (IfBranch 'Parsed 'BranchIfElse) + +instance NFData (IfBranch 'Parsed 'BranchIfBool) + +deriving stock instance Show (IfBranch 'Parsed 'BranchIfElse) + +deriving stock instance Show (IfBranch 'Parsed 'BranchIfBool) + +deriving stock instance Show (IfBranch 'Scoped 'BranchIfElse) + +deriving stock instance Show (IfBranch 'Scoped 'BranchIfBool) + +deriving stock instance Eq (IfBranch 'Parsed 'BranchIfElse) + +deriving stock instance Eq (IfBranch 'Parsed 'BranchIfBool) + +deriving stock instance Eq (IfBranch 'Scoped 'BranchIfElse) + +deriving stock instance Eq (IfBranch 'Scoped 'BranchIfBool) + +deriving stock instance Ord (IfBranch 'Parsed 'BranchIfElse) + +deriving stock instance Ord (IfBranch 'Parsed 'BranchIfBool) + +deriving stock instance Ord (IfBranch 'Scoped 'BranchIfElse) + +deriving stock instance Ord (IfBranch 'Scoped 'BranchIfBool) + +data If (s :: Stage) = If + { _ifKw :: KeywordRef, + _ifBranches :: [IfBranch s 'BranchIfBool], + _ifBranchElse :: IfBranch s 'BranchIfElse + } + deriving stock (Generic) + +instance Serialize (If 'Scoped) + +instance NFData (If 'Scoped) + +instance Serialize (If 'Parsed) + +instance NFData (If 'Parsed) + +deriving stock instance Show (If 'Parsed) + +deriving stock instance Show (If 'Scoped) + +deriving stock instance Eq (If 'Parsed) + +deriving stock instance Eq (If 'Scoped) + +deriving stock instance Ord (If 'Parsed) + +deriving stock instance Ord (If 'Scoped) + +data Initializer (s :: Stage) = Initializer + { _initializerPattern :: PatternParensType s, + _initializerAssignKw :: Irrelevant KeywordRef, + _initializerExpression :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (Initializer 'Scoped) + +instance NFData (Initializer 'Scoped) + +instance Serialize (Initializer 'Parsed) + +instance NFData (Initializer 'Parsed) + +deriving stock instance Show (Initializer 'Parsed) + +deriving stock instance Show (Initializer 'Scoped) + +deriving stock instance Eq (Initializer 'Parsed) + +deriving stock instance Eq (Initializer 'Scoped) + +deriving stock instance Ord (Initializer 'Parsed) + +deriving stock instance Ord (Initializer 'Scoped) + +data Range (s :: Stage) = Range + { _rangePattern :: PatternParensType s, + _rangeInKw :: Irrelevant KeywordRef, + _rangeExpression :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (Range 'Scoped) + +instance NFData (Range 'Scoped) + +instance Serialize (Range 'Parsed) + +instance NFData (Range 'Parsed) + +deriving stock instance Show (Range 'Parsed) + +deriving stock instance Show (Range 'Scoped) + +deriving stock instance Eq (Range 'Parsed) + +deriving stock instance Eq (Range 'Scoped) + +deriving stock instance Ord (Range 'Parsed) + +deriving stock instance Ord (Range 'Scoped) + +data Iterator s = Iterator + { _iteratorName :: IdentifierType s, + _iteratorInitializers :: [Initializer s], + _iteratorRanges :: [Range s], + _iteratorBody :: ExpressionType s, + -- | Was the body enclosed in braces? + _iteratorBodyBraces :: Bool, + -- | Due to limitations of the pretty printing algorithm, we store whether + -- the iterator was surrounded by parentheses in the code. + _iteratorParens :: Bool + } + deriving stock (Generic) + +instance Serialize (Iterator 'Scoped) + +instance NFData (Iterator 'Scoped) + +instance Serialize (Iterator 'Parsed) + +instance NFData (Iterator 'Parsed) + +deriving stock instance Show (Iterator 'Parsed) + +deriving stock instance Show (Iterator 'Scoped) + +deriving stock instance Eq (Iterator 'Parsed) + +deriving stock instance Eq (Iterator 'Scoped) + +deriving stock instance Ord (Iterator 'Parsed) + +deriving stock instance Ord (Iterator 'Scoped) + +data List (s :: Stage) = List + { _listBracketL :: Irrelevant KeywordRef, + _listBracketR :: Irrelevant KeywordRef, + _listItems :: [ExpressionType s] + } + deriving stock (Generic) + +instance Serialize (List 'Scoped) + +instance NFData (List 'Scoped) + +instance Serialize (List 'Parsed) + +instance NFData (List 'Parsed) + +deriving stock instance Show (List 'Parsed) + +deriving stock instance Show (List 'Scoped) + +deriving stock instance Eq (List 'Parsed) + +deriving stock instance Eq (List 'Scoped) + +deriving stock instance Ord (List 'Parsed) + +deriving stock instance Ord (List 'Scoped) + +data NamedArgumentAssign (s :: Stage) = NamedArgumentAssign + { _namedArgName :: SymbolType s, + _namedArgAssignKw :: Irrelevant KeywordRef, + _namedArgValue :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (NamedArgumentAssign 'Scoped) + +instance NFData (NamedArgumentAssign 'Scoped) + +instance Serialize (NamedArgumentAssign 'Parsed) + +instance NFData (NamedArgumentAssign 'Parsed) + +deriving stock instance Show (NamedArgumentAssign 'Parsed) + +deriving stock instance Show (NamedArgumentAssign 'Scoped) + +deriving stock instance Eq (NamedArgumentAssign 'Parsed) + +deriving stock instance Eq (NamedArgumentAssign 'Scoped) + +deriving stock instance Ord (NamedArgumentAssign 'Parsed) + +deriving stock instance Ord (NamedArgumentAssign 'Scoped) + +data ArgumentBlock (s :: Stage) = ArgumentBlock + { _argBlockDelims :: Irrelevant (Maybe (KeywordRef, KeywordRef)), + _argBlockImplicit :: IsImplicit, + _argBlockArgs :: NonEmpty (NamedArgumentAssign s) + } + deriving stock (Generic) + +instance Serialize (ArgumentBlock 'Scoped) + +instance NFData (ArgumentBlock 'Scoped) + +instance Serialize (ArgumentBlock 'Parsed) + +instance NFData (ArgumentBlock 'Parsed) + +deriving stock instance Show (ArgumentBlock 'Parsed) + +deriving stock instance Show (ArgumentBlock 'Scoped) + +deriving stock instance Eq (ArgumentBlock 'Parsed) + +deriving stock instance Eq (ArgumentBlock 'Scoped) + +deriving stock instance Ord (ArgumentBlock 'Parsed) + +deriving stock instance Ord (ArgumentBlock 'Scoped) + +data RecordUpdateExtra = RecordUpdateExtra + { _recordUpdateExtraConstructor :: S.Symbol, + -- | Implicitly bound fields sorted by index + _recordUpdateExtraVars :: [S.Symbol] + } + deriving stock (Generic) + +instance Serialize RecordUpdateExtra + +instance NFData RecordUpdateExtra + +newtype ParensRecordUpdate = ParensRecordUpdate + { _parensRecordUpdate :: RecordUpdate 'Scoped + } + deriving stock (Show, Eq, Ord, Generic) + +instance Serialize ParensRecordUpdate + +instance NFData ParensRecordUpdate + +data RecordUpdate (s :: Stage) = RecordUpdate + { _recordUpdateAtKw :: Irrelevant KeywordRef, + _recordUpdateDelims :: Irrelevant (KeywordRef, KeywordRef), + _recordUpdateTypeName :: IdentifierType s, + _recordUpdateExtra :: Irrelevant (RecordUpdateExtraType s), + _recordUpdateFields :: [RecordUpdateField s] + } + deriving stock (Generic) + +instance Serialize (RecordUpdate 'Scoped) + +instance NFData (RecordUpdate 'Scoped) + +instance Serialize (RecordUpdate 'Parsed) + +instance NFData (RecordUpdate 'Parsed) + +deriving stock instance Show (RecordUpdate 'Parsed) + +deriving stock instance Show (RecordUpdate 'Scoped) + +deriving stock instance Eq (RecordUpdate 'Parsed) + +deriving stock instance Eq (RecordUpdate 'Scoped) + +deriving stock instance Ord (RecordUpdate 'Parsed) + +deriving stock instance Ord (RecordUpdate 'Scoped) + +data RecordUpdateApp = RecordUpdateApp + { _recordAppUpdate :: RecordUpdate 'Scoped, + _recordAppExpression :: Expression + } + deriving stock (Show, Eq, Ord, Generic) + +instance Serialize RecordUpdateApp + +instance NFData RecordUpdateApp + +data NamedApplication (s :: Stage) = NamedApplication + { _namedAppName :: IdentifierType s, + _namedAppArgs :: NonEmpty (ArgumentBlock s) + } + deriving stock (Generic) + +instance Serialize (NamedApplication 'Scoped) + +instance NFData (NamedApplication 'Scoped) + +instance Serialize (NamedApplication 'Parsed) + +instance NFData (NamedApplication 'Parsed) + +deriving stock instance Show (NamedApplication 'Parsed) + +deriving stock instance Show (NamedApplication 'Scoped) + +deriving stock instance Eq (NamedApplication 'Parsed) + +deriving stock instance Eq (NamedApplication 'Scoped) + +deriving stock instance Ord (NamedApplication 'Parsed) + +deriving stock instance Ord (NamedApplication 'Scoped) + +newtype NamedArgumentFunctionDef (s :: Stage) = NamedArgumentFunctionDef + { _namedArgumentFunctionDef :: FunctionDef s + } + deriving stock (Generic) + +instance Serialize (NamedArgumentFunctionDef 'Scoped) + +instance NFData (NamedArgumentFunctionDef 'Scoped) + +instance Serialize (NamedArgumentFunctionDef 'Parsed) + +instance NFData (NamedArgumentFunctionDef 'Parsed) + +deriving stock instance Show (NamedArgumentFunctionDef 'Parsed) + +deriving stock instance Show (NamedArgumentFunctionDef 'Scoped) + +deriving stock instance Eq (NamedArgumentFunctionDef 'Parsed) + +deriving stock instance Eq (NamedArgumentFunctionDef 'Scoped) + +deriving stock instance Ord (NamedArgumentFunctionDef 'Parsed) + +deriving stock instance Ord (NamedArgumentFunctionDef 'Scoped) + +newtype NamedArgumentNew (s :: Stage) + = NamedArgumentNewFunction (NamedArgumentFunctionDef s) + deriving stock (Generic) + +instance Serialize (NamedArgumentNew 'Scoped) + +instance NFData (NamedArgumentNew 'Scoped) + +instance Serialize (NamedArgumentNew 'Parsed) + +instance NFData (NamedArgumentNew 'Parsed) + +deriving stock instance Show (NamedArgumentNew 'Parsed) + +deriving stock instance Show (NamedArgumentNew 'Scoped) + +deriving stock instance Eq (NamedArgumentNew 'Parsed) + +deriving stock instance Eq (NamedArgumentNew 'Scoped) + +deriving stock instance Ord (NamedArgumentNew 'Parsed) + +deriving stock instance Ord (NamedArgumentNew 'Scoped) + +data IsExhaustive = IsExhaustive + { _isExhaustive :: Bool, + _isExhaustiveKw :: Irrelevant KeywordRef + } + deriving stock (Eq, Show, Ord, Generic) + +instance Serialize IsExhaustive + +instance NFData IsExhaustive + +data NamedApplicationNew (s :: Stage) = NamedApplicationNew + { _namedApplicationNewName :: IdentifierType s, + _namedApplicationNewExhaustive :: IsExhaustive, + _namedApplicationNewArguments :: [NamedArgumentNew s] + } + deriving stock (Generic) + +instance Serialize (NamedApplicationNew 'Scoped) + +instance NFData (NamedApplicationNew 'Scoped) + +instance Serialize (NamedApplicationNew 'Parsed) + +instance NFData (NamedApplicationNew 'Parsed) + +deriving stock instance Show (NamedApplicationNew 'Parsed) + +deriving stock instance Show (NamedApplicationNew 'Scoped) + +deriving stock instance Eq (NamedApplicationNew 'Parsed) + +deriving stock instance Eq (NamedApplicationNew 'Scoped) + +deriving stock instance Ord (NamedApplicationNew 'Parsed) + +deriving stock instance Ord (NamedApplicationNew 'Scoped) + +data RecordStatement (s :: Stage) + = RecordStatementField (RecordField s) + | RecordStatementOperator OperatorSyntaxDef + deriving stock (Generic) + +instance Serialize (RecordStatement 'Scoped) + +instance NFData (RecordStatement 'Scoped) + +deriving stock instance Show (RecordStatement 'Parsed) + +deriving stock instance Show (RecordStatement 'Scoped) + +deriving stock instance Eq (RecordStatement 'Parsed) + +deriving stock instance Eq (RecordStatement 'Scoped) + +deriving stock instance Ord (RecordStatement 'Parsed) + +deriving stock instance Ord (RecordStatement 'Scoped) + +-- | Expressions without application +data ExpressionAtom (s :: Stage) + = AtomIdentifier (IdentifierType s) + | AtomLambda (Lambda s) + | AtomList (List s) + | AtomCase (Case s) + | AtomIf (If s) + | AtomHole (HoleType s) + | AtomInstanceHole (HoleType s) + | AtomDoubleBraces (DoubleBracesExpression s) + | AtomBraces (WithLoc (ExpressionType s)) + | AtomLet (Let s) + | AtomRecordUpdate (RecordUpdate s) + | AtomUniverse Universe + | AtomFunction (Function s) + | AtomFunArrow KeywordRef + | AtomLiteral LiteralLoc + | AtomParens (ExpressionType s) + | AtomIterator (Iterator s) + | AtomNamedApplication (NamedApplication s) + | AtomNamedApplicationNew (NamedApplicationNew s) + deriving stock (Generic) + +instance Serialize (ExpressionAtom 'Parsed) + +instance NFData (ExpressionAtom 'Parsed) + +deriving stock instance Show (ExpressionAtom 'Parsed) + +deriving stock instance Show (ExpressionAtom 'Scoped) + +deriving stock instance Eq (ExpressionAtom 'Parsed) + +deriving stock instance Eq (ExpressionAtom 'Scoped) + +deriving stock instance Ord (ExpressionAtom 'Parsed) + +deriving stock instance Ord (ExpressionAtom 'Scoped) + +data ExpressionAtoms (s :: Stage) = ExpressionAtoms + { _expressionAtoms :: NonEmpty (ExpressionAtom s), + _expressionAtomsLoc :: Irrelevant Interval + } + deriving stock (Generic) + +instance Serialize (ExpressionAtoms 'Parsed) + +instance NFData (ExpressionAtoms 'Parsed) + +deriving stock instance Show (ExpressionAtoms 'Parsed) + +deriving stock instance Show (ExpressionAtoms 'Scoped) + +deriving stock instance Eq (ExpressionAtoms 'Parsed) + +deriving stock instance Eq (ExpressionAtoms 'Scoped) + +deriving stock instance Ord (ExpressionAtoms 'Parsed) + +deriving stock instance Ord (ExpressionAtoms 'Scoped) + +newtype Judoc (s :: Stage) = Judoc + { _judocGroups :: NonEmpty (JudocGroup s) + } + deriving newtype (Semigroup, Generic) + +instance Serialize (Judoc 'Scoped) + +instance NFData (Judoc 'Scoped) + +instance Serialize (Judoc 'Parsed) + +instance NFData (Judoc 'Parsed) + +deriving stock instance Show (Judoc 'Parsed) + +deriving stock instance Show (Judoc 'Scoped) + +deriving stock instance Eq (Judoc 'Parsed) + +deriving stock instance Eq (Judoc 'Scoped) + +deriving stock instance Ord (Judoc 'Parsed) + +deriving stock instance Ord (Judoc 'Scoped) + +data Example (s :: Stage) = Example + { _exampleId :: NameId, + _exampleLoc :: Interval, + _exampleExpression :: ExpressionType s + } + deriving stock (Generic) + +instance Serialize (Example 'Scoped) + +instance NFData (Example 'Scoped) + +instance Serialize (Example 'Parsed) + +instance NFData (Example 'Parsed) + +deriving stock instance Show (Example 'Parsed) + +deriving stock instance Show (Example 'Scoped) + +deriving stock instance Eq (Example 'Parsed) + +deriving stock instance Eq (Example 'Scoped) + +deriving stock instance Ord (Example 'Parsed) + +deriving stock instance Ord (Example 'Scoped) + +data JudocBlockParagraph (s :: Stage) = JudocBlockParagraph + { _judocBlockParagraphStart :: KeywordRef, + _judocBlockParagraphBlocks :: [JudocBlock s], + _judocBlockParagraphEnd :: KeywordRef + } + deriving stock (Generic) + +instance Serialize (JudocBlockParagraph 'Scoped) + +instance NFData (JudocBlockParagraph 'Scoped) + +instance Serialize (JudocBlockParagraph 'Parsed) + +instance NFData (JudocBlockParagraph 'Parsed) + +deriving stock instance Show (JudocBlockParagraph 'Parsed) + +deriving stock instance Show (JudocBlockParagraph 'Scoped) + +deriving stock instance Eq (JudocBlockParagraph 'Parsed) + +deriving stock instance Eq (JudocBlockParagraph 'Scoped) + +deriving stock instance Ord (JudocBlockParagraph 'Parsed) + +deriving stock instance Ord (JudocBlockParagraph 'Scoped) + +data JudocGroup (s :: Stage) + = JudocGroupBlock (JudocBlockParagraph s) + | JudocGroupLines (NonEmpty (JudocBlock s)) + deriving stock (Generic) + +instance Serialize (JudocGroup 'Scoped) + +instance NFData (JudocGroup 'Scoped) + +instance Serialize (JudocGroup 'Parsed) + +instance NFData (JudocGroup 'Parsed) + +deriving stock instance Show (JudocGroup 'Parsed) + +deriving stock instance Show (JudocGroup 'Scoped) + +deriving stock instance Eq (JudocGroup 'Parsed) + +deriving stock instance Eq (JudocGroup 'Scoped) + +deriving stock instance Ord (JudocGroup 'Parsed) + +deriving stock instance Ord (JudocGroup 'Scoped) + +newtype JudocBlock (s :: Stage) + = JudocLines (NonEmpty (JudocLine s)) + deriving stock (Generic) + +instance Serialize (JudocBlock 'Scoped) + +instance NFData (JudocBlock 'Scoped) + +instance Serialize (JudocBlock 'Parsed) + +instance NFData (JudocBlock 'Parsed) + +deriving stock instance Show (JudocBlock 'Parsed) + +deriving stock instance Show (JudocBlock 'Scoped) + +deriving stock instance Eq (JudocBlock 'Parsed) + +deriving stock instance Eq (JudocBlock 'Scoped) + +deriving stock instance Ord (JudocBlock 'Parsed) + +deriving stock instance Ord (JudocBlock 'Scoped) + +data JudocLine (s :: Stage) = JudocLine + { _judocLineDelim :: Maybe KeywordRef, + _judocLineAtoms :: NonEmpty (WithLoc (JudocAtom s)) + } + deriving stock (Generic) + +instance Serialize (JudocLine 'Scoped) + +instance NFData (JudocLine 'Scoped) + +instance Serialize (JudocLine 'Parsed) + +instance NFData (JudocLine 'Parsed) + +deriving stock instance Show (JudocLine 'Parsed) + +deriving stock instance Show (JudocLine 'Scoped) + +deriving stock instance Eq (JudocLine 'Parsed) + +deriving stock instance Eq (JudocLine 'Scoped) + +deriving stock instance Ord (JudocLine 'Parsed) + +deriving stock instance Ord (JudocLine 'Scoped) + +data JudocAtom (s :: Stage) + = JudocExpression (ExpressionType s) + | JudocText Text + deriving stock (Generic) + +instance Serialize (JudocAtom 'Scoped) + +instance NFData (JudocAtom 'Scoped) + +instance Serialize (JudocAtom 'Parsed) + +instance NFData (JudocAtom 'Parsed) + +deriving stock instance Show (JudocAtom 'Parsed) + +deriving stock instance Show (JudocAtom 'Scoped) + +deriving stock instance Eq (JudocAtom 'Parsed) + +deriving stock instance Eq (JudocAtom 'Scoped) + +deriving stock instance Ord (JudocAtom 'Parsed) + +deriving stock instance Ord (JudocAtom 'Scoped) + +makeLenses ''SideIfs +makeLenses ''NamedArgumentFunctionDef +makeLenses ''IsExhaustive +makeLenses ''SideIfBranch +makeLenses ''RhsExpression +makeLenses ''PatternArg +makeLenses ''WildcardConstructor +makeLenses ''DoubleBracesExpression +makeLenses ''FieldPun +makeLenses ''RecordPatternAssign +makeLenses ''RecordPattern +makeLenses ''ParensRecordUpdate +makeLenses ''RecordUpdateExtra +makeLenses ''RecordUpdate +makeLenses ''RecordUpdateApp +makeLenses ''RecordUpdateField +makeLenses ''NonDefinitionsSection +makeLenses ''DefinitionsSection +makeLenses ''ProjectionDef +makeLenses ''ScopedIden +makeLenses ''FixityDef +makeLenses ''RecordField +makeLenses ''RhsRecord +makeLenses ''RhsAdt +makeLenses ''RhsGadt +makeLenses ''List +makeLenses ''ListPattern +makeLenses ''UsingItem +makeLenses ''HidingItem +makeLenses ''HidingList +makeLenses ''UsingList +makeLenses ''JudocLine +makeLenses ''Example +makeLenses ''Lambda +makeLenses ''LambdaClause +makeLenses ''Judoc +makeLenses ''JudocBlockParagraph +makeLenses ''Function +makeLenses ''InductiveDef +makeLenses ''PostfixApplication +makeLenses ''InfixApplication +makeLenses ''Application +makeLenses ''Let +makeLenses ''FunctionParameters +makeLenses ''Import +makeLenses ''OperatorSyntaxDef +makeLenses ''IteratorSyntaxDef +makeLenses ''ConstructorDef +makeLenses ''Module +makeLenses ''SigArg +makeLenses ''ArgDefault +makeLenses ''FunctionDef +makeLenses ''AxiomDef +makeLenses ''InductiveParameters +makeLenses ''InductiveParametersRhs +makeLenses ''OpenModule +makeLenses ''PatternApp +makeLenses ''PatternInfixApp +makeLenses ''PatternPostfixApp +makeLenses ''Case +makeLenses ''CaseBranch +makeLenses ''If +makeLenses ''IfBranch +makeLenses ''PatternBinding +makeLenses ''PatternAtoms +makeLenses ''ExpressionAtoms +makeLenses ''Iterator +makeLenses ''Initializer +makeLenses ''Range +makeLenses ''ArgumentBlock +makeLenses ''NamedArgumentAssign +makeLenses ''NamedApplication +makeLenses ''NamedArgumentNew +makeLenses ''NamedApplicationNew +makeLenses ''AliasDef +makeLenses ''FixitySyntaxDef +makeLenses ''ParsedFixityInfo +makeLenses ''ParsedFixityFields +makeLenses ''NameSignature +makeLenses ''RecordNameSignature +makeLenses ''NameBlock +makeLenses ''NameItem +makeLenses ''RecordInfo +makeLenses ''MarkdownInfo +makePrisms ''NamedArgumentNew + +fixityFieldHelper :: SimpleGetter (ParsedFixityFields s) (Maybe a) -> SimpleGetter (ParsedFixityInfo s) (Maybe a) +fixityFieldHelper l = to (^? fixityFields . _Just . l . _Just) + +fixityAssoc :: SimpleGetter (ParsedFixityInfo s) (Maybe (BinaryAssoc)) +fixityAssoc = fixityFieldHelper fixityFieldsAssoc + +fixityPrecSame :: SimpleGetter (ParsedFixityInfo s) (Maybe (SymbolType s)) +fixityPrecSame = fixityFieldHelper fixityFieldsPrecSame + +fixityPrecAbove :: SimpleGetter (ParsedFixityInfo s) (Maybe [SymbolType s]) +fixityPrecAbove = fixityFieldHelper fixityFieldsPrecAbove + +fixityPrecBelow :: SimpleGetter (ParsedFixityInfo s) (Maybe [SymbolType s]) +fixityPrecBelow = fixityFieldHelper fixityFieldsPrecBelow + +instance (SingI s) => HasLoc (AliasDef s) where + getLoc AliasDef {..} = getLoc _aliasDefSyntaxKw <> getLocIdentifierType _aliasDefAsName + +instance HasLoc (ParsedFixityFields s) where + getLoc d = getLoc l <> getLoc r + where + (l, r) = d ^. fixityFieldsBraces . unIrrelevant + +instance HasLoc (ParsedFixityInfo s) where + getLoc def = getLoc (def ^. fixityParsedArity) <>? (getLoc <$> def ^. fixityFields) + +instance HasLoc (FixitySyntaxDef s) where + getLoc def = getLoc (def ^. fixitySyntaxKw) <> getLoc (def ^. fixityInfo) + +instance (SingI s) => HasLoc (SyntaxDef s) where + getLoc = \case + SyntaxFixity t -> getLoc t + SyntaxOperator t -> getLoc t + SyntaxIterator t -> getLoc t + SyntaxAlias t -> getLoc t + +instance (SingI s) => HasLoc (NamedArgumentAssign s) where + getLoc NamedArgumentAssign {..} = getLocSymbolType _namedArgName <> getLocExpressionType _namedArgValue + +instance (SingI s) => HasLoc (ArgumentBlock s) where + getLoc ArgumentBlock {..} = case d of + Just (l, r) -> getLoc l <> getLoc r + Nothing -> getLocSpan _argBlockArgs + where + Irrelevant d = _argBlockDelims + +instance HasAtomicity (ArgumentBlock s) where + atomicity = const Atom + +instance HasAtomicity (NamedApplication s) where + atomicity = const (Aggregate appFixity) + +instance HasAtomicity (NamedApplicationNew s) where + atomicity = const (Aggregate updateFixity) + +instance HasAtomicity Expression where + atomicity e = case e of + ExpressionIdentifier {} -> Atom + ExpressionHole {} -> Atom + ExpressionInstanceHole {} -> Atom + ExpressionParensIdentifier {} -> Atom + ExpressionApplication {} -> Aggregate appFixity + ExpressionInfixApplication a -> Aggregate (getFixity a) + ExpressionPostfixApplication a -> Aggregate (getFixity a) + ExpressionLambda l -> atomicity l + ExpressionLiteral l -> atomicity l + ExpressionLet l -> atomicity l + ExpressionBraces {} -> Atom + ExpressionDoubleBraces {} -> Atom + ExpressionList {} -> Atom + ExpressionUniverse {} -> Atom + ExpressionFunction {} -> Aggregate funFixity + ExpressionCase c -> atomicity c + ExpressionIf x -> atomicity x + ExpressionIterator i -> atomicity i + ExpressionNamedApplication i -> atomicity i + ExpressionNamedApplicationNew i -> atomicity i + ExpressionRecordUpdate {} -> Aggregate updateFixity + ExpressionParensRecordUpdate {} -> Atom + +expressionAtomicity :: forall s. (SingI s) => ExpressionType s -> Atomicity +expressionAtomicity e = case sing :: SStage s of + SParsed -> atomicity e + SScoped -> atomicity e + +instance HasAtomicity (Iterator s) where + atomicity = const Atom + +instance HasAtomicity (Case s) where + atomicity = const Atom + +instance HasAtomicity (If s) where + atomicity = const Atom + +instance HasAtomicity (Let 'Scoped) where + atomicity l = atomicity (l ^. letExpression) + +instance HasAtomicity (PatternAtom 'Parsed) where + atomicity = const Atom + +instance (SingI s) => HasAtomicity (FunctionParameters s) where + atomicity p + | not (null (p ^. paramNames)) + || p ^. paramImplicit == Implicit + || p ^. paramImplicit == ImplicitInstance = + Atom + | otherwise = case sing :: SStage s of + SParsed -> atomicity (p ^. paramType) + SScoped -> atomicity (p ^. paramType) + +instance Pretty ScopedIden where + pretty = pretty . (^. scopedIdenSrcName) + +instance HasLoc ScopedIden where + getLoc = getLoc . (^. scopedIdenSrcName) + +instance (SingI s) => HasLoc (InductiveParameters s) where + getLoc i = getLocSymbolType (i ^. inductiveParametersNames . _head1) <>? (getLocExpressionType <$> (i ^? inductiveParametersRhs . _Just . inductiveParametersType)) + +instance HasLoc (InductiveDef s) where + getLoc i = (getLoc <$> i ^. inductivePositive) ?<> getLoc (i ^. inductiveKw) + +instance (SingI s) => HasLoc (AxiomDef s) where + getLoc m = getLoc (m ^. axiomKw) <> getLocExpressionType (m ^. axiomType) + +getLocPublicAnn :: PublicAnn -> Maybe Interval +getLocPublicAnn p = getLoc <$> p ^? _Public + +instance HasLoc (OpenModule s short) where + getLoc OpenModule {..} = + getLoc _openModuleKw + <>? fmap getLoc _openModuleUsingHiding + <>? getLocPublicAnn _openModulePublic + +instance HasLoc (ProjectionDef s) where + getLoc = getLoc . (^. projectionConstructor) + +instance HasLoc (Statement 'Scoped) where + getLoc :: Statement 'Scoped -> Interval + getLoc = \case + StatementSyntax t -> getLoc t + StatementFunctionDef t -> getLoc t + StatementImport t -> getLoc t + StatementInductive t -> getLoc t + StatementModule t -> getLoc t + StatementOpenModule t -> getLoc t + StatementAxiom t -> getLoc t + StatementProjectionDef t -> getLoc t + +instance HasLoc Application where + getLoc (Application l r) = getLoc l <> getLoc r + +instance HasLoc InfixApplication where + getLoc (InfixApplication l _ r) = getLoc l <> getLoc r + +instance HasLoc PostfixApplication where + getLoc (PostfixApplication l o) = getLoc l <> getLoc o + +instance HasLoc (LambdaClause 'Scoped) where + getLoc c = + fmap getLoc (c ^. lambdaPipe . unIrrelevant) + ?<> getLocSpan (c ^. lambdaParameters) + <> getLoc (c ^. lambdaBody) + +instance HasLoc (Lambda 'Scoped) where + getLoc l = getLoc (l ^. lambdaKw) <> getLoc (l ^. lambdaBraces . unIrrelevant . _2) + +instance HasLoc (FunctionParameter 'Scoped) where + getLoc = \case + FunctionParameterName n -> getLoc n + FunctionParameterWildcard w -> getLoc w + +instance HasLoc (FunctionParameters 'Scoped) where + getLoc p = case p ^. paramDelims . unIrrelevant of + Nothing -> (getLoc <$> listToMaybe (p ^. paramNames)) ?<> getLoc (p ^. paramType) + Just (l, r) -> getLoc l <> getLoc r + +instance HasLoc (Function 'Scoped) where + getLoc f = getLoc (f ^. funParameters) <> getLoc (f ^. funReturn) + +instance HasLoc (Let 'Scoped) where + getLoc l = getLoc (l ^. letKw) <> getLoc (l ^. letExpression) + +instance (SingI s) => HasLoc (SideIfBranch s k) where + getLoc SideIfBranch {..} = + (getLoc <$> _sideIfBranchPipe ^. unIrrelevant) + ?<> getLocExpressionType _sideIfBranchBody + +instance (SingI s) => HasLoc (SideIfs s) where + getLoc SideIfs {..} = + getLocSpan _sideIfBranches + <>? (getLoc <$> _sideIfElse) + +instance (SingI s) => HasLoc (RhsExpression s) where + getLoc RhsExpression {..} = + getLoc _rhsExpressionAssignKw + <> getLocExpressionType _rhsExpression + +instance (SingI s) => HasLoc (CaseBranchRhs s) where + getLoc = \case + CaseBranchRhsExpression e -> getLoc e + CaseBranchRhsIf e -> getLoc e + +instance (SingI s) => HasLoc (CaseBranch s) where + getLoc c = case c ^. caseBranchPipe . unIrrelevant of + Nothing -> branchLoc + Just p -> getLoc p <> branchLoc + where + branchLoc :: Interval + branchLoc = getLoc (c ^. caseBranchRhs) + +instance (SingI s) => HasLoc (IfBranch s k) where + getLoc c = getLoc (c ^. ifBranchPipe) <> getLocExpressionType (c ^. ifBranchExpression) + +instance (SingI s) => HasLoc (Case s) where + getLoc c = getLoc (c ^. caseKw) <> getLoc (c ^. caseBranches . to last) + +instance (SingI s) => HasLoc (If s) where + getLoc c = getLoc (c ^. ifKw) <> getLoc (c ^. ifBranchElse) + +instance HasLoc (List s) where + getLoc List {..} = getLoc _listBracketL <> getLoc _listBracketR + +instance (SingI s) => HasLoc (NamedApplication s) where + getLoc NamedApplication {..} = getLocIdentifierType _namedAppName <> getLoc (last _namedAppArgs) + +instance (SingI s) => HasLoc (NamedApplicationNew s) where + getLoc NamedApplicationNew {..} = getLocIdentifierType _namedApplicationNewName + +instance (SingI s) => HasLoc (RecordUpdateField s) where + getLoc f = getLocSymbolType (f ^. fieldUpdateName) <> getLocExpressionType (f ^. fieldUpdateValue) + +instance HasLoc (RecordUpdate s) where + getLoc r = getLoc (r ^. recordUpdateAtKw) <> getLoc (r ^. recordUpdateDelims . unIrrelevant . _2) + +instance HasLoc RecordUpdateApp where + getLoc r = getLoc (r ^. recordAppExpression) <> getLoc (r ^. recordAppUpdate) + +instance HasLoc ParensRecordUpdate where + getLoc = getLoc . (^. parensRecordUpdate) + +instance HasLoc (DoubleBracesExpression s) where + getLoc DoubleBracesExpression {..} = + let (l, r) = _doubleBracesDelims ^. unIrrelevant + in getLoc l <> getLoc r + +instance HasAtomicity (DoubleBracesExpression s) where + atomicity = const Atom + +instance HasLoc Expression where + getLoc = \case + ExpressionIdentifier i -> getLoc i + ExpressionParensIdentifier i -> getLoc i + ExpressionApplication i -> getLoc i + ExpressionInfixApplication i -> getLoc i + ExpressionPostfixApplication i -> getLoc i + ExpressionLambda i -> getLoc i + ExpressionList l -> getLoc l + ExpressionCase i -> getLoc i + ExpressionIf x -> getLoc x + ExpressionLet i -> getLoc i + ExpressionUniverse i -> getLoc i + ExpressionLiteral i -> getLoc i + ExpressionFunction i -> getLoc i + ExpressionHole i -> getLoc i + ExpressionInstanceHole i -> getLoc i + ExpressionBraces i -> getLoc i + ExpressionDoubleBraces i -> getLoc i + ExpressionIterator i -> getLoc i + ExpressionNamedApplication i -> getLoc i + ExpressionNamedApplicationNew i -> getLoc i + ExpressionRecordUpdate i -> getLoc i + ExpressionParensRecordUpdate i -> getLoc i + +getLocIdentifierType :: forall s. (SingI s) => IdentifierType s -> Interval +getLocIdentifierType e = case sing :: SStage s of + SParsed -> getLoc e + SScoped -> getLoc e + +instance (SingI s) => HasLoc (Iterator s) where + getLoc Iterator {..} = getLocIdentifierType _iteratorName <> getLocExpressionType _iteratorBody + +instance HasLoc (HidingList s) where + getLoc HidingList {..} = + let rbra = _hidingBraces ^. unIrrelevant . _2 + in getLoc (_hidingKw ^. unIrrelevant) <> getLoc rbra + +instance HasLoc (UsingList s) where + getLoc UsingList {..} = + let rbra = _usingBraces ^. unIrrelevant . _2 + in getLoc (_usingKw ^. unIrrelevant) <> getLoc rbra + +instance HasLoc (UsingHiding s) where + getLoc = \case + Using u -> getLoc u + Hiding u -> getLoc u + +instance (SingI s) => HasLoc (Import s) where + getLoc Import {..} = + let sLoc = case sing :: SStage s of + SParsed -> + getLoc _importKw + <> getLoc _importModulePath + <>? (getLoc <$> _importOpen) + SScoped -> + getLoc _importKw + <> getLoc _importModulePath + <>? (getLoc <$> _importOpen) + in sLoc <>? fmap getLoc (_importPublic ^? _Public) + +instance (SingI s, SingI t) => HasLoc (Module s t) where + getLoc m = case sing :: SStage s of + SParsed -> case sing :: SModuleIsTop t of + SModuleLocal -> getLoc (m ^. modulePath) + SModuleTop -> getLoc (m ^. modulePath) + SScoped -> case sing :: SModuleIsTop t of + SModuleLocal -> getLoc (m ^. modulePath) + SModuleTop -> getLoc (m ^. modulePath) + +getLocSymbolType :: forall s. (SingI s) => SymbolType s -> Interval +getLocSymbolType = case sing :: SStage s of + SParsed -> getLoc + SScoped -> getLoc + +getLocExpressionType :: forall s. (SingI s) => ExpressionType s -> Interval +getLocExpressionType = case sing :: SStage s of + SParsed -> getLoc + SScoped -> getLoc + +instance (SingI s) => HasLoc (ArgDefault s) where + getLoc ArgDefault {..} = getLoc _argDefaultAssign <> getLocExpressionType _argDefaultValue + +instance HasLoc (SigArg s) where + getLoc SigArg {..} = getLoc l <> getLoc r + where + Irrelevant (l, r) = _sigArgDelims + +instance (SingI s) => HasLoc (FunctionClause s) where + getLoc FunctionClause {..} = + getLoc _clausenPipeKw + <> getLocExpressionType _clausenBody + +instance (SingI s) => HasLoc (FunctionDefBody s) where + getLoc = \case + SigBodyExpression e -> getLocExpressionType e + SigBodyClauses cl -> getLocSpan cl + +instance (SingI s) => HasLoc (FunctionDef s) where + getLoc FunctionDef {..} = + (getLoc <$> _signDoc) + ?<> (getLoc <$> _signPragmas) + ?<> (getLoc <$> _signBuiltin) + ?<> (getLoc <$> _signTerminating) + ?<> getLocSymbolType _signName + <> getLoc _signBody + +instance HasLoc (Example s) where + getLoc e = e ^. exampleLoc + +instance HasLoc (Judoc s) where + getLoc (Judoc j) = getLocSpan j + +instance HasLoc (JudocBlockParagraph s) where + getLoc p = getLoc (p ^. judocBlockParagraphStart) <> getLoc (p ^. judocBlockParagraphEnd) + +instance HasLoc (JudocGroup s) where + getLoc = \case + JudocGroupBlock l -> getLoc l + JudocGroupLines l -> getLocSpan l + +instance HasLoc (JudocBlock s) where + getLoc = \case + JudocLines ls -> getLocSpan ls + +instance HasLoc PatternScopedIden where + getLoc = \case + PatternScopedVar v -> getLoc v + PatternScopedConstructor c -> getLoc c + +instance HasLoc PatternBinding where + getLoc PatternBinding {..} = getLoc _patternBindingName <> getLoc _patternBindingPattern + +instance HasLoc (ListPattern s) where + getLoc l = getLoc (l ^. listpBracketL) <> getLoc (l ^. listpBracketR) + +getLocPatternParensType :: forall s. (SingI s) => PatternParensType s -> Interval +getLocPatternParensType = case sing :: SStage s of + SScoped -> getLoc + SParsed -> getLoc + +instance (SingI s) => HasLoc (RecordPatternAssign s) where + getLoc a = + getLoc (a ^. recordPatternAssignField) + <> getLocPatternParensType (a ^. recordPatternAssignPattern) + +instance (SingI s) => HasLoc (FieldPun s) where + getLoc f = getLocSymbolType (f ^. fieldPunField) + +instance (SingI s) => HasLoc (RecordPatternItem s) where + getLoc = \case + RecordPatternItemAssign a -> getLoc a + RecordPatternItemFieldPun a -> getLoc a + +instance (SingI s) => HasLoc (RecordPattern s) where + getLoc r = getLocIdentifierType (r ^. recordPatternConstructor) <>? (getLocSpan <$> nonEmpty (r ^. recordPatternItems)) + +instance (SingI s) => HasLoc (WildcardConstructor s) where + getLoc WildcardConstructor {..} = + getLocIdentifierType _wildcardConstructor + +instance (SingI s) => HasLoc (PatternAtom s) where + getLoc = \case + PatternAtomIden i -> getLocIden i + PatternAtomWildcard w -> getLoc w + PatternAtomWildcardConstructor w -> getLoc w + PatternAtomEmpty i -> i + PatternAtomList l -> getLoc l + PatternAtomParens p -> getLocParens p + PatternAtomBraces p -> getLocParens p + PatternAtomDoubleBraces p -> getLocParens p + PatternAtomAt p -> getLocAt p + PatternAtomRecord p -> getLoc p + where + getLocAt :: forall r. (SingI r) => PatternAtType r -> Interval + getLocAt p = case sing :: SStage r of + SParsed -> getLoc p + SScoped -> getLoc p + getLocIden :: forall r. (SingI r) => PatternAtomIdenType r -> Interval + getLocIden p = case sing :: SStage r of + SParsed -> getLoc p + SScoped -> getLoc p + getLocParens :: forall r. (SingI r) => PatternParensType r -> Interval + getLocParens p = case sing :: SStage r of + SParsed -> getLoc p + SScoped -> getLoc p + +instance HasLoc (JudocLine s) where + getLoc (JudocLine delim atoms) = fmap getLoc delim ?<> getLocSpan atoms + +instance HasLoc (PatternAtoms s) where + getLoc = getLoc . (^. patternAtomsLoc) + +instance HasLoc PatternArg where + getLoc a = fmap getLoc (a ^. patternArgName) ?<> getLoc (a ^. patternArgPattern) + +instance HasLoc PatternInfixApp where + getLoc (PatternInfixApp l _ r) = + getLoc l <> getLoc r + +instance HasLoc PatternPostfixApp where + getLoc (PatternPostfixApp l _) = getLoc l + +instance HasLoc PatternApp where + getLoc (PatternApp l r) = getLoc l <> getLoc r + +instance HasLoc Pattern where + getLoc = \case + PatternVariable v -> getLoc v + PatternWildcardConstructor v -> getLoc v + PatternConstructor c -> getLoc c + PatternApplication a -> getLoc a + PatternWildcard w -> getLoc w + PatternList w -> getLoc w + PatternEmpty i -> i + PatternInfixApplication i -> getLoc i + PatternPostfixApplication i -> getLoc i + PatternRecord i -> getLoc i + +instance HasLoc (ExpressionAtoms s) where + getLoc = getLoc . (^. expressionAtomsLoc) + +instance HasAtomicity (ExpressionAtoms 'Parsed) where + atomicity ExpressionAtoms {..} = case _expressionAtoms of + (_ :| []) -> Atom + (_ :| _) + | any isArrow _expressionAtoms -> Aggregate funFixity + | otherwise -> Aggregate appFixity + where + isArrow :: ExpressionAtom s -> Bool + isArrow = \case + AtomFunArrow {} -> True + _ -> False + +data ApeLeaf + = ApeLeafExpression Expression + | ApeLeafFunctionParams (FunctionParameters 'Scoped) + | ApeLeafFunctionKw KeywordRef + | ApeLeafPattern Pattern + | ApeLeafPatternArg PatternArg + | ApeLeafAtom (AnyStage ExpressionAtom) + +_ConstructorRhsRecord :: Traversal' (ConstructorRhs s) (RhsRecord s) +_ConstructorRhsRecord f rhs = case rhs of + ConstructorRhsRecord r -> ConstructorRhsRecord <$> f r + _ -> pure rhs + +_DefinitionSyntax :: Traversal' (Definition s) (SyntaxDef s) +_DefinitionSyntax f x = case x of + DefinitionSyntax r -> DefinitionSyntax <$> f r + _ -> pure x + +_SyntaxAlias :: Traversal' (SyntaxDef s) (AliasDef s) +_SyntaxAlias f x = case x of + SyntaxAlias r -> SyntaxAlias <$> f r + _ -> pure x + +_RecordStatementField :: Traversal' (RecordStatement s) (RecordField s) +_RecordStatementField f x = case x of + RecordStatementField p -> RecordStatementField <$> f p + _ -> pure x + +namedArgumentNewSymbol :: Lens' (NamedArgumentNew s) (SymbolType s) +namedArgumentNewSymbol f = \case + NamedArgumentNewFunction a -> + NamedArgumentNewFunction + <$> (namedArgumentFunctionDef . signName) f a + +scopedIdenSrcName :: Lens' ScopedIden S.Name +scopedIdenSrcName f n = case n ^. scopedIdenAlias of + Nothing -> scopedIdenFinal f n + Just a -> do + a' <- f a + pure (set scopedIdenAlias (Just a') n) + +fromParsedIteratorInfo :: ParsedIteratorInfo -> IteratorInfo +fromParsedIteratorInfo ParsedIteratorInfo {..} = + IteratorInfo + { _iteratorInfoInitNum = (^. withLocParam) <$> _parsedIteratorInfoInitNum, + _iteratorInfoRangeNum = (^. withLocParam) <$> _parsedIteratorInfoRangeNum + } + +instance HasFixity PostfixApplication where + getFixity (PostfixApplication _ op) = fromMaybe impossible (op ^. scopedIdenSrcName . S.nameFixity) + +instance HasFixity InfixApplication where + getFixity (InfixApplication _ op _) = fromMaybe impossible (op ^. scopedIdenSrcName . S.nameFixity) + +instance HasFixity PatternInfixApp where + getFixity (PatternInfixApp _ op _) = fromMaybe impossible (op ^. scopedIdenSrcName . S.nameFixity) + +instance HasFixity PatternPostfixApp where + getFixity (PatternPostfixApp _ op) = fromMaybe impossible (op ^. scopedIdenSrcName . S.nameFixity) + +instance HasAtomicity (ListPattern s) where + atomicity = const Atom + +instance HasAtomicity (RecordPattern s) where + atomicity = const Atom + +instance HasAtomicity (WildcardConstructor s) where + atomicity = const Atom + +instance HasAtomicity Pattern where + atomicity e = case e of + PatternVariable {} -> Atom + PatternWildcardConstructor a -> atomicity a + PatternConstructor {} -> Atom + PatternApplication {} -> Aggregate appFixity + PatternInfixApplication a -> Aggregate (getFixity a) + PatternPostfixApplication p -> Aggregate (getFixity p) + PatternWildcard {} -> Atom + PatternList l -> atomicity l + PatternEmpty {} -> Atom + PatternRecord r -> atomicity r diff --git a/src/Juvix/Compiler/Concrete/Language/IsApeInstances.hs b/src/Juvix/Compiler/Concrete/Language/IsApeInstances.hs new file mode 100644 index 0000000000..3cd65514e6 --- /dev/null +++ b/src/Juvix/Compiler/Concrete/Language/IsApeInstances.hs @@ -0,0 +1,198 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module Juvix.Compiler.Concrete.Language.IsApeInstances where + +import Juvix.Compiler.Concrete.Data.ScopedName qualified as S +import Juvix.Compiler.Concrete.Language.Base +import Juvix.Compiler.Concrete.MigrateNamedApplication +import Juvix.Data.Ape.Base as Ape +import Juvix.Data.NameKind +import Juvix.Parser.Lexer (isDelimiterStr) +import Juvix.Prelude +import Juvix.Prelude.Pretty (prettyText) + +instance IsApe PatternApp ApeLeaf where + toApe (PatternApp l r) = + ApeApp + Ape.App + { _appLeft = toApe l, + _appRight = toApe r + } + +instance IsApe Pattern ApeLeaf where + toApe = \case + PatternApplication a -> toApe a + PatternInfixApplication a -> toApe a + PatternPostfixApplication a -> toApe a + e -> + ApeLeaf + Leaf + { _leafAtomicity = atomicity e, + _leafExpr = ApeLeafPattern e + } + +instance IsApe PatternArg ApeLeaf where + toApe pa + | Atom == atomicity pa = + ApeLeaf + Leaf + { _leafAtomicity = Atom, + _leafExpr = ApeLeafPatternArg pa + } + | otherwise = toApe (pa ^. patternArgPattern) + +instance IsApe PatternPostfixApp ApeLeaf where + toApe p@(PatternPostfixApp l op) = + ApePostfix + Postfix + { _postfixFixity = getFixity p, + _postfixLeft = toApe l, + _postfixOp = ApeLeafPattern (PatternConstructor op) + } + +instance IsApe PatternInfixApp ApeLeaf where + toApe i@(PatternInfixApp l op r) = + ApeInfix + Infix + { _infixFixity = getFixity i, + _infixLeft = toApe l, + _infixRight = toApe r, + _infixIsDelimiter = isDelimiterStr (prettyText (op ^. scopedIdenSrcName . S.nameConcrete)), + _infixOp = ApeLeafPattern (PatternConstructor op) + } + +instance IsApe ScopedIden ApeLeaf where + toApe iden = + ApeLeaf + Leaf + { _leafAtomicity = Atom, + _leafExpr = ApeLeafExpression (ExpressionIdentifier iden) + } + +toApeIdentifierType :: forall s. (SingI s) => IdentifierType s -> Ape ApeLeaf +toApeIdentifierType = case sing :: SStage s of + SParsed -> toApe + SScoped -> toApe + +instance IsApe Name ApeLeaf where + toApe n = + ApeLeaf + Leaf + { _leafAtomicity = atomicity n, + _leafExpr = ApeLeafAtom (sing :&: AtomIdentifier n) + } + +instance (SingI s) => IsApe (NamedApplication s) ApeLeaf where + toApe = toApe . migrateNamedApplication + +-- f = toApeIdentifierType _namedAppName + +instance (SingI s) => IsApe (NamedApplicationNew s) ApeLeaf where + toApe a = + ApeLeaf $ + Leaf + { _leafAtomicity = atomicity a, + _leafExpr = ApeLeafAtom (sing :&: AtomNamedApplicationNew a) + } + +instance IsApe Application ApeLeaf where + toApe (Application l r) = + ApeApp + Ape.App + { _appLeft = toApe l, + _appRight = toApe r + } + +instance IsApe InfixApplication ApeLeaf where + toApe i@(InfixApplication l op r) = + ApeInfix + Infix + { _infixFixity = getFixity i, + _infixLeft = toApe l, + _infixRight = toApe r, + _infixIsDelimiter = isDelimiterStr (prettyText (op ^. scopedIdenSrcName . S.nameConcrete)), + _infixOp = ApeLeafExpression (ExpressionIdentifier op) + } + +instance IsApe PostfixApplication ApeLeaf where + toApe p@(PostfixApplication l op) = + ApePostfix + Postfix + { _postfixFixity = getFixity p, + _postfixLeft = toApe l, + _postfixOp = ApeLeafExpression (ExpressionIdentifier op) + } + +instance IsApe (Function 'Scoped) ApeLeaf where + toApe (Function ps kw ret) = + ApeInfix + Infix + { _infixFixity = funFixity, + _infixLeft = toApe ps, + _infixRight = toApe ret, + _infixIsDelimiter = False, + _infixOp = ApeLeafFunctionKw kw + } + +instance IsApe RecordUpdateApp ApeLeaf where + toApe :: RecordUpdateApp -> Ape ApeLeaf + toApe a = + ApePostfix + Postfix + { _postfixFixity = updateFixity, + _postfixOp = ApeLeafAtom (sing :&: AtomRecordUpdate (a ^. recordAppUpdate)), + _postfixLeft = toApe (a ^. recordAppExpression) + } + +instance IsApe Expression ApeLeaf where + toApe e = case e of + ExpressionApplication a -> toApe a + ExpressionInfixApplication a -> toApe a + ExpressionPostfixApplication a -> toApe a + ExpressionFunction a -> toApe a + ExpressionNamedApplication a -> toApe a + ExpressionNamedApplicationNew a -> toApe a + ExpressionRecordUpdate a -> toApe a + ExpressionParensRecordUpdate {} -> leaf + ExpressionParensIdentifier {} -> leaf + ExpressionIdentifier {} -> leaf + ExpressionList {} -> leaf + ExpressionCase {} -> leaf + ExpressionIf {} -> leaf + ExpressionLambda {} -> leaf + ExpressionLet {} -> leaf + ExpressionUniverse {} -> leaf + ExpressionHole {} -> leaf + ExpressionInstanceHole {} -> leaf + ExpressionLiteral {} -> leaf + ExpressionBraces {} -> leaf + ExpressionDoubleBraces {} -> leaf + ExpressionIterator {} -> leaf + where + leaf = + ApeLeaf + Leaf + { _leafAtomicity = atomicity e, + _leafExpr = ApeLeafExpression e + } + +instance IsApe (FunctionParameters 'Scoped) ApeLeaf where + toApe f + | atomicity f == Atom = + ApeLeaf + Leaf + { _leafAtomicity = Atom, + _leafExpr = ApeLeafFunctionParams f + } + | otherwise = toApe (f ^. paramType) + +instance HasAtomicity PatternArg where + atomicity p + | Implicit <- p ^. patternArgIsImplicit = Atom + | ImplicitInstance <- p ^. patternArgIsImplicit = Atom + | isJust (p ^. patternArgName) = Atom + | otherwise = atomicity (p ^. patternArgPattern) + +instance HasNameKind ScopedIden where + getNameKind = getNameKind . (^. scopedIdenFinal) + getNameKindPretty = getNameKindPretty . (^. scopedIdenFinal) diff --git a/src/Juvix/Compiler/Concrete/MigrateNamedApplication.hs b/src/Juvix/Compiler/Concrete/MigrateNamedApplication.hs new file mode 100644 index 0000000000..95cf80b506 --- /dev/null +++ b/src/Juvix/Compiler/Concrete/MigrateNamedApplication.hs @@ -0,0 +1,29 @@ +module Juvix.Compiler.Concrete.MigrateNamedApplication where + +import Juvix.Compiler.Concrete.Gen qualified as Gen +import Juvix.Compiler.Concrete.Keywords +import Juvix.Compiler.Concrete.Language.Base +import Juvix.Prelude + +migrateNamedApplication :: forall s. (SingI s) => NamedApplication s -> NamedApplicationNew s +migrateNamedApplication old@NamedApplication {..} = run . runReader (getLoc old) $ do + _namedApplicationNewAtKw <- Irrelevant <$> Gen.kw kwAt + _namedApplicationNewExhaustive <- Gen.isExhaustive False + return + NamedApplicationNew + { _namedApplicationNewName = _namedAppName, + _namedApplicationNewArguments = migrateNamedApplicationArguments (toList _namedAppArgs), + _namedApplicationNewExhaustive + } + where + migrateNamedApplicationArguments :: [ArgumentBlock s] -> [NamedArgumentNew s] + migrateNamedApplicationArguments = concatMap goBlock + where + goBlock :: ArgumentBlock s -> [NamedArgumentNew s] + goBlock ArgumentBlock {..} = map goArg (toList _argBlockArgs) + where + goArg :: NamedArgumentAssign s -> NamedArgumentNew s + goArg = NamedArgumentNewFunction . NamedArgumentFunctionDef . toFun + + toFun :: NamedArgumentAssign s -> FunctionDef s + toFun NamedArgumentAssign {..} = Gen.simplestFunctionDef _namedArgName _namedArgValue diff --git a/src/Juvix/Compiler/Concrete/Print/Base.hs b/src/Juvix/Compiler/Concrete/Print/Base.hs index 6ee8f0dee4..a409d85f2c 100644 --- a/src/Juvix/Compiler/Concrete/Print/Base.hs +++ b/src/Juvix/Compiler/Concrete/Print/Base.hs @@ -17,6 +17,7 @@ import Juvix.Compiler.Concrete.Gen qualified as Gen import Juvix.Compiler.Concrete.Keywords import Juvix.Compiler.Concrete.Keywords qualified as Kw import Juvix.Compiler.Concrete.Language +import Juvix.Compiler.Concrete.MigrateNamedApplication import Juvix.Compiler.Concrete.Pretty.Options import Juvix.Compiler.Concrete.Translation.ImportScanner.Base import Juvix.Compiler.Pipeline.Loader.PathResolver.Data @@ -294,9 +295,9 @@ instance (SingI s) => PrettyPrint (List s) where es = vcatPreSemicolon (map ppExpressionType _listItems) grouped (align (l <> spaceOrEmpty <> es <> lineOrEmpty <> r)) -instance (SingI s) => PrettyPrint (NamedArgument s) where - ppCode NamedArgument {..} = do - let s = ppCode _namedArgName +instance (SingI s) => PrettyPrint (NamedArgumentAssign s) where + ppCode NamedArgumentAssign {..} = do + let s = ppSymbolType _namedArgName kwassign = ppCode _namedArgAssignKw val = ppExpressionType _namedArgValue s <+> kwassign <+> val @@ -312,24 +313,30 @@ instance (SingI s) => PrettyPrint (ArgumentBlock s) where Irrelevant d = _argBlockDelims instance (SingI s) => PrettyPrint (NamedApplication s) where - ppCode = apeHelper + ppCode = ppCode . migrateNamedApplication + +instance PrettyPrint IsExhaustive where + ppCode IsExhaustive {..} = ppCode _isExhaustiveKw instance (SingI s) => PrettyPrint (NamedApplicationNew s) where ppCode NamedApplicationNew {..} = do let args' | null _namedApplicationNewArguments = mempty | otherwise = - blockIndent - ( sequenceWith - (semicolon >> line) - (ppCode <$> _namedApplicationNewArguments) - ) + blockIndent $ + sequenceWith + (semicolon >> line) + (ppCode <$> _namedApplicationNewArguments) ppIdentifierType _namedApplicationNewName - <> ppCode _namedApplicationNewAtKw + <> ppCode _namedApplicationNewExhaustive <> braces args' +instance (SingI s) => PrettyPrint (NamedArgumentFunctionDef s) where + ppCode (NamedArgumentFunctionDef f) = ppCode f + instance (SingI s) => PrettyPrint (NamedArgumentNew s) where - ppCode NamedArgumentNew {..} = ppCode _namedArgumentNewFunDef + ppCode = \case + NamedArgumentNewFunction f -> ppCode f instance (SingI s) => PrettyPrint (RecordStatement s) where ppCode = \case @@ -668,7 +675,6 @@ instance PrettyPrint ApeLeaf where ApeLeafPattern r -> ppCode r ApeLeafPatternArg r -> ppCode r ApeLeafAtom r -> ppAnyStage r - ApeLeafArgumentBlock r -> ppAnyStage r annDef :: forall s r. (SingI s, Members '[ExactPrint] r) => SymbolType s -> Sem r () -> Sem r () annDef nm = case sing :: SStage s of diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs index 89d7b4450f..0aecdb2810 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs @@ -1099,6 +1099,7 @@ checkFunctionDef FunctionDef {..} = do checkBody = case _signBody of SigBodyExpression e -> SigBodyExpression <$> checkParseExpressionAtoms e SigBodyClauses cls -> SigBodyClauses <$> mapM checkClause cls + checkClause :: FunctionClause 'Parsed -> Sem r (FunctionClause 'Scoped) checkClause FunctionClause {..} = do (patterns', body') <- withLocalScope $ do @@ -2569,6 +2570,10 @@ checkExpressionAtom e = case e of AtomNamedApplicationNew i -> pure . AtomNamedApplicationNew <$> checkNamedApplicationNew i AtomRecordUpdate i -> pure . AtomRecordUpdate <$> checkRecordUpdate i +reserveNamedArgumentName :: (Members '[Error ScoperError, NameIdGen, State ScoperSyntax, State Scope, State ScoperState, Reader BindingStrategy, InfoTableBuilder, Reader InfoTable] r) => NamedArgumentNew 'Parsed -> Sem r () +reserveNamedArgumentName a = case a of + NamedArgumentNewFunction f -> void (reserveFunctionSymbol (f ^. namedArgumentFunctionDef)) + checkNamedApplicationNew :: forall r. (Members '[HighlightBuilder, Error ScoperError, State Scope, State ScoperState, Reader ScopeParameters, InfoTableBuilder, Reader InfoTable, NameIdGen, Reader Package] r) => NamedApplicationNew 'Parsed -> Sem r (NamedApplicationNew 'Scoped) checkNamedApplicationNew napp = do let nargs = napp ^. namedApplicationNewArguments @@ -2576,18 +2581,21 @@ checkNamedApplicationNew napp = do sig <- if null nargs then return $ NameSignature [] else getNameSignature aname let snames = HashSet.fromList (concatMap (HashMap.keys . (^. nameBlock)) (sig ^. nameSignatureArgs)) args' <- withLocalScope . localBindings . ignoreSyntax $ do - mapM_ (reserveFunctionSymbol . (^. namedArgumentNewFunDef)) nargs + mapM_ reserveNamedArgumentName nargs mapM (checkNamedArgumentNew snames) nargs - let enames = HashSet.fromList (concatMap (HashMap.keys . (^. nameBlock)) (filter (not . isImplicitOrInstance . (^. nameImplicit)) (sig ^. nameSignatureArgs))) - sargs = HashSet.fromList (map (^. namedArgumentNewFunDef . signName . nameConcrete) (toList args')) + let enames = + HashSet.fromList + . concatMap (HashMap.keys . (^. nameBlock)) + . filter (not . isImplicitOrInstance . (^. nameImplicit)) + $ sig ^. nameSignatureArgs + sargs :: HashSet Symbol = hashSet (map (^. namedArgumentNewSymbol) nargs) missingArgs = HashSet.difference enames sargs - unless (null missingArgs || not (napp ^. namedApplicationNewExhaustive)) $ + unless (null missingArgs || not (napp ^. namedApplicationNewExhaustive . isExhaustive)) $ throw (ErrMissingArgs (MissingArgs (aname ^. scopedIdenFinal . nameConcrete) missingArgs)) return NamedApplicationNew { _namedApplicationNewName = aname, _namedApplicationNewArguments = args', - _namedApplicationNewAtKw = napp ^. namedApplicationNewAtKw, _namedApplicationNewExhaustive = napp ^. namedApplicationNewExhaustive } @@ -2596,14 +2604,22 @@ checkNamedArgumentNew :: HashSet Symbol -> NamedArgumentNew 'Parsed -> Sem r (NamedArgumentNew 'Scoped) -checkNamedArgumentNew snames NamedArgumentNew {..} = do - def <- localBindings . ignoreSyntax $ checkFunctionDef _namedArgumentNewFunDef +checkNamedArgumentNew snames = \case + NamedArgumentNewFunction f -> NamedArgumentNewFunction <$> checkNamedArgumentFunctionDef snames f + +checkNamedArgumentFunctionDef :: + (Members '[HighlightBuilder, Error ScoperError, State Scope, State ScoperState, Reader ScopeParameters, InfoTableBuilder, Reader InfoTable, NameIdGen, Reader Package] r) => + HashSet Symbol -> + NamedArgumentFunctionDef 'Parsed -> + Sem r (NamedArgumentFunctionDef 'Scoped) +checkNamedArgumentFunctionDef snames NamedArgumentFunctionDef {..} = do + def <- localBindings . ignoreSyntax $ checkFunctionDef _namedArgumentFunctionDef let fname = def ^. signName . nameConcrete unless (HashSet.member fname snames) $ throw (ErrUnexpectedArgument (UnexpectedArgument fname)) return - NamedArgumentNew - { _namedArgumentNewFunDef = def + NamedArgumentFunctionDef + { _namedArgumentFunctionDef = def } checkRecordUpdate :: forall r. (Members '[HighlightBuilder, Error ScoperError, State Scope, State ScoperState, Reader ScopeParameters, InfoTableBuilder, Reader InfoTable, NameIdGen, Reader Package] r) => RecordUpdate 'Parsed -> Sem r (RecordUpdate 'Scoped) @@ -2658,20 +2674,24 @@ checkNamedApplication napp = do _namedAppArgs <- mapM checkArgumentBlock (napp ^. namedAppArgs) return NamedApplication {..} where - checkNamedArg :: NamedArgument 'Parsed -> Sem r (NamedArgument 'Scoped) - checkNamedArg n = do - let _namedArgName = n ^. namedArgName - _namedArgAssignKw = n ^. namedArgAssignKw - _namedArgValue <- checkParseExpressionAtoms (n ^. namedArgValue) - return NamedArgument {..} - checkArgumentBlock :: ArgumentBlock 'Parsed -> Sem r (ArgumentBlock 'Scoped) checkArgumentBlock b = do let _argBlockDelims = b ^. argBlockDelims _argBlockImplicit = b ^. argBlockImplicit - _argBlockArgs <- mapM checkNamedArg (b ^. argBlockArgs) + _argBlockArgs <- mapM checkNamedArgumentAssign (b ^. argBlockArgs) return ArgumentBlock {..} +checkNamedArgumentAssign :: + forall r. + (Members '[HighlightBuilder, Reader ScopeParameters, Error ScoperError, State Scope, State ScoperState, InfoTableBuilder, Reader InfoTable, NameIdGen, Reader Package] r) => + NamedArgumentAssign 'Parsed -> + Sem r (NamedArgumentAssign 'Scoped) +checkNamedArgumentAssign n = do + _namedArgName <- withLocalScope (bindVariableSymbol (n ^. namedArgName)) + let _namedArgAssignKw = n ^. namedArgAssignKw + _namedArgValue <- checkParseExpressionAtoms (n ^. namedArgValue) + return NamedArgumentAssign {..} + getRecordInfo :: forall r. (Members '[State ScoperState, Error ScoperError] r) => diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error.hs index b64617dcd1..3434c2433a 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error.hs @@ -10,6 +10,7 @@ import Juvix.Compiler.Concrete.Data.NameSignature.Error import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Pretty import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Types import Juvix.Compiler.Internal.Translation.FromConcrete.NamedArguments.Error +import Juvix.Prelude.Base.Foundation data ScoperError = ErrInfixParser InfixError @@ -55,6 +56,7 @@ data ScoperError | ErrWrongDefaultValue WrongDefaultValue | ErrUnsupported Unsupported | ErrDefaultArgCycle DefaultArgCycle + deriving stock (Generic) instance ToGenericError ScoperError where genericError = \case diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs index 893eb45754..6f7a61000b 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs @@ -869,10 +869,6 @@ pdoubleBracesExpression = do _expressionAtomsLoc = Irrelevant i } --------------------------------------------------------------------------------- --- Iterators --------------------------------------------------------------------------------- - iterator :: forall r. (Members '[ParserResultBuilder, PragmasStash, JudocStash] r) => @@ -967,36 +963,60 @@ iterator = do s <- P.try rangeStart rangeCont s - mkNamedArgument :: Int -> Initializer 'Parsed -> ParsecS r (NamedArgument 'Parsed) + mkNamedArgument :: Int -> Initializer 'Parsed -> ParsecS r (NamedArgumentAssign 'Parsed) mkNamedArgument off Initializer {..} = do let _namedArgAssignKw = _initializerAssignKw _namedArgValue = _initializerExpression _namedArgName <- case _initializerPattern ^. patternAtoms of PatternAtomIden (NameUnqualified n) :| [] -> return n _ -> parseFailure off "an iterator must have at least one range" - return NamedArgument {..} + return NamedArgumentAssign {..} + +pnamedArgumentFunctionDef :: + forall r. + (Members '[ParserResultBuilder, PragmasStash, JudocStash] r) => + ParsecS r (NamedArgumentFunctionDef 'Parsed) +pnamedArgumentFunctionDef = do + fun <- functionDefinition True False Nothing + return + NamedArgumentFunctionDef + { _namedArgumentFunctionDef = fun + } + +namedArgumentNew :: + forall r. + (Members '[ParserResultBuilder, PragmasStash, JudocStash] r) => + ParsecS r (NamedArgumentNew 'Parsed) +namedArgumentNew = NamedArgumentNewFunction <$> pnamedArgumentFunctionDef + +pisExhaustive :: + forall r. + (Members '[ParserResultBuilder] r) => + ParsecS r IsExhaustive +pisExhaustive = do + (keyword, exh) <- + (,False) <$> kw kwAtQuestion + <|> (,True) <$> kw kwAt + return + IsExhaustive + { _isExhaustiveKw = Irrelevant keyword, + _isExhaustive = exh + } namedApplicationNew :: forall r. (Members '[ParserResultBuilder, PragmasStash, JudocStash] r) => ParsecS r (NamedApplicationNew 'Parsed) namedApplicationNew = P.label "" $ do - (_namedApplicationNewName, _namedApplicationNewAtKw, _namedApplicationNewExhaustive) <- P.try $ do + (_namedApplicationNewName, _namedApplicationNewExhaustive) <- P.try $ do n <- name - (a, b) <- first Irrelevant <$> ((,False) <$> kw kwAtQuestion <|> (,True) <$> kw kwAt) + exhaustive <- pisExhaustive lbrace - return (n, a, b) - defs <- P.sepEndBy (functionDefinition True False Nothing) semicolon + return (n, exhaustive) + _namedApplicationNewArguments <- P.sepEndBy namedArgumentNew semicolon rbrace - let _namedApplicationNewArguments = fmap mkArg defs - _namedApplicationNewExtra = Irrelevant () + let _namedApplicationNewExtra = Irrelevant () return NamedApplicationNew {..} - where - mkArg :: FunctionDef 'Parsed -> NamedArgumentNew 'Parsed - mkArg f = - NamedArgumentNew - { _namedArgumentNewFunDef = f - } namedApplication :: forall r. @@ -1013,15 +1033,15 @@ namedApplication = P.label "" $ do _namedAppSignature = Irrelevant () return NamedApplication {..} -namedArgument :: +namedArgumentAssign :: forall r. (Members '[ParserResultBuilder, PragmasStash, JudocStash] r) => - ParsecS r (NamedArgument 'Parsed) -namedArgument = do + ParsecS r (NamedArgumentAssign 'Parsed) +namedArgumentAssign = do _namedArgName <- symbol _namedArgAssignKw <- Irrelevant <$> kw kwAssign _namedArgValue <- parseExpressionAtoms - return NamedArgument {..} + return NamedArgumentAssign {..} argumentBlockStart :: forall r. @@ -1040,8 +1060,8 @@ argumentBlockCont :: ParsecS r (ArgumentBlock 'Parsed) argumentBlockCont (l, _argBlockImplicit, _namedArgName, _namedArgAssignKw) = do _namedArgValue <- parseExpressionAtoms - let arg = NamedArgument {..} - _argBlockArgs <- nonEmpty' . (arg :) <$> many (semicolon >> namedArgument) + let arg = NamedArgumentAssign {..} + _argBlockArgs <- nonEmpty' . (arg :) <$> many (semicolon >> namedArgumentAssign) r <- implicitClose _argBlockImplicit let _argBlockDelims = Irrelevant (Just (l, r)) return ArgumentBlock {..} diff --git a/src/Juvix/Compiler/Internal/Extra.hs b/src/Juvix/Compiler/Internal/Extra.hs index 76d51d6229..a42aaf1e48 100644 --- a/src/Juvix/Compiler/Internal/Extra.hs +++ b/src/Juvix/Compiler/Internal/Extra.hs @@ -170,8 +170,8 @@ buildLetMutualBlocks ss = nonEmpty' . mapMaybe nameToPreStatement $ scomponents AcyclicSCC a -> AcyclicSCC <$> a CyclicSCC p -> CyclicSCC . toList <$> nonEmpty (catMaybes p) -mkLetClauses :: NonEmpty PreLetStatement -> [LetClause] -mkLetClauses pre = goSCC <$> (toList (buildLetMutualBlocks pre)) +mkLetClauses :: NonEmpty PreLetStatement -> NonEmpty LetClause +mkLetClauses pre = goSCC <$> buildLetMutualBlocks pre where goSCC :: SCC PreLetStatement -> LetClause goSCC = \case diff --git a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs index 0276c1ec8b..a42e934821 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs +++ b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs @@ -719,6 +719,49 @@ goListPattern l = do where loc = getLoc l +createArgumentBlocks :: NonEmpty (NamedArgumentNew 'Scoped) -> [NameBlock 'Scoped] -> [ArgumentBlock 'Scoped] +createArgumentBlocks appargs = + run + . execOutputList + . evalState args0 + . mapM_ goBlock + where + args0 :: HashSet S.Symbol = hashSet ((^. namedArgumentNewSymbol) <$> appargs) + goBlock :: + forall r. + (Members '[State (HashSet S.Symbol), Output (ArgumentBlock 'Scoped)] r) => + NameBlock 'Scoped -> + Sem r () + goBlock NameBlock {..} = do + args <- get + let namesInBlock :: HashSet Symbol = + HashSet.intersection + (HashMap.keysSet _nameBlock) + (HashSet.map (^. S.nameConcrete) args) + argNames :: HashMap Symbol S.Symbol = hashMap . map (\n -> (n ^. S.nameConcrete, n)) $ toList args + getName sym = fromJust (argNames ^. at sym) + whenJust (nonEmpty namesInBlock) $ \(namesInBlock1 :: NonEmpty Symbol) -> do + let block' = + ArgumentBlock + { _argBlockDelims = Irrelevant Nothing, + _argBlockImplicit = _nameImplicit, + _argBlockArgs = goArg . getName <$> namesInBlock1 + } + modify (HashSet.filter (not . flip HashSet.member namesInBlock . (^. S.nameConcrete))) + output block' + where + goArg :: S.Symbol -> NamedArgumentAssign 'Scoped + goArg sym = + NamedArgumentAssign + { _namedArgName = sym, + _namedArgAssignKw = Irrelevant dummyKw, + _namedArgValue = Concrete.ExpressionIdentifier (ScopedIden name Nothing) + } + where + name :: S.Name = over S.nameConcrete NameUnqualified sym + dummyKw = run (runReader dummyLoc (Gen.kw Gen.kwAssign)) + dummyLoc = getLoc sym + goExpression :: forall r. (Members '[Reader DefaultArgsStack, Builtins, NameIdGen, Error ScoperError, Reader Pragmas, Reader S.InfoTable] r) => @@ -753,71 +796,41 @@ goExpression = \case s <- asks (^. S.infoNameSigs) runReader s (runNamedArguments w extraArgs) >>= goDesugaredNamedApplication - goNamedApplicationNew :: Concrete.NamedApplicationNew 'Scoped -> [Internal.ApplicationArg] -> Sem r Internal.Expression + goNamedApplicationNew :: + Concrete.NamedApplicationNew 'Scoped -> + [Internal.ApplicationArg] -> + Sem r Internal.Expression goNamedApplicationNew napp extraArgs = case nonEmpty (napp ^. namedApplicationNewArguments) of Nothing -> return (goIden (napp ^. namedApplicationNewName)) Just appargs -> do let name = napp ^. namedApplicationNewName . scopedIdenFinal sig <- fromJust <$> asks (^. S.infoNameSigs . at (name ^. S.nameId)) - cls <- goArgs appargs - let args :: [Internal.Name] = appargs ^.. each . namedArgumentNewFunDef . signName . to goSymbol - -- changes the kind from Variable to Function - updateKind :: Internal.Subs = Internal.subsKind args KNameFunction - napp' = + let napp' = Concrete.NamedApplication { _namedAppName = napp ^. namedApplicationNewName, - _namedAppArgs = nonEmpty' (createArgumentBlocks (sig ^. nameSignatureArgs)) - } - e <- goNamedApplication napp' extraArgs - let l = - Internal.Let - { _letClauses = cls, - _letExpression = e + _namedAppArgs = nonEmpty' (createArgumentBlocks appargs (sig ^. nameSignatureArgs)) } - expr <- - Internal.substitutionE updateKind l - >>= Internal.inlineLet - Internal.clone expr - where - goArgs :: NonEmpty (NamedArgumentNew 'Scoped) -> Sem r (NonEmpty Internal.LetClause) - goArgs args = nonEmpty' . mkLetClauses <$> mapM goArg args - where - goArg :: NamedArgumentNew 'Scoped -> Sem r Internal.PreLetStatement - goArg = fmap Internal.PreLetFunctionDef . goFunctionDef . (^. namedArgumentNewFunDef) - - createArgumentBlocks :: [NameBlock 'Scoped] -> [ArgumentBlock 'Scoped] - createArgumentBlocks = snd . foldr goBlock (args0, []) + compiledNameApp <- goNamedApplication napp' extraArgs + case nonEmpty (appargs ^.. each . _NamedArgumentNewFunction) of + Nothing -> return compiledNameApp + Just funs -> do + cls <- funDefsToClauses funs + let funsNames :: [Internal.Name] = funs ^.. each . namedArgumentFunctionDef . signName . to goSymbol + -- changes the kind from Variable to Function + updateKind :: Internal.Subs = Internal.subsKind funsNames KNameFunction + let l = + Internal.Let + { _letClauses = cls, + _letExpression = compiledNameApp + } + expr <- Internal.substitutionE updateKind l >>= Internal.inlineLet + Internal.clone expr where - args0 :: HashSet S.Symbol = HashSet.fromList $ fmap (^. namedArgumentNewFunDef . signName) (toList appargs) - goBlock :: NameBlock 'Scoped -> (HashSet S.Symbol, [ArgumentBlock 'Scoped]) -> (HashSet S.Symbol, [ArgumentBlock 'Scoped]) - goBlock NameBlock {..} (args, blocks) - | null namesInBlock = (args', blocks) - | otherwise = (args', block' : blocks) + funDefsToClauses :: NonEmpty (NamedArgumentFunctionDef 'Scoped) -> Sem r (NonEmpty Internal.LetClause) + funDefsToClauses args = mkLetClauses <$> mapM goArg args where - namesInBlock = - HashSet.intersection - (HashSet.fromList (HashMap.keys _nameBlock)) - (HashSet.map (^. S.nameConcrete) args) - argNames = HashMap.fromList . map (\n -> (n ^. S.nameConcrete, n)) $ toList args - args' = HashSet.filter (not . flip HashSet.member namesInBlock . (^. S.nameConcrete)) args - _argBlockArgs = nonEmpty' (map goArg (toList namesInBlock)) - block' = - ArgumentBlock - { _argBlockDelims = Irrelevant Nothing, - _argBlockImplicit = _nameImplicit, - _argBlockArgs - } - goArg :: Symbol -> NamedArgument 'Scoped - goArg sym = - NamedArgument - { _namedArgName = sym, - _namedArgAssignKw = Irrelevant dummyKw, - _namedArgValue = Concrete.ExpressionIdentifier (ScopedIden name Nothing) - } - where - name = over S.nameConcrete NameUnqualified $ fromJust $ HashMap.lookup sym argNames - dummyKw = run (runReader dummyLoc (Gen.kw Gen.kwAssign)) - dummyLoc = getLoc sym + goArg :: NamedArgumentFunctionDef 'Scoped -> Sem r Internal.PreLetStatement + goArg = fmap Internal.PreLetFunctionDef . goFunctionDef . (^. namedArgumentFunctionDef) goDesugaredNamedApplication :: DesugaredNamedApplication -> Sem r Internal.Expression goDesugaredNamedApplication a = do @@ -977,7 +990,7 @@ goExpression = \case Nothing -> _letExpression goLetFunDefs :: NonEmpty (LetStatement 'Scoped) -> Sem r [Internal.LetClause] - goLetFunDefs clauses = maybe [] mkLetClauses . nonEmpty <$> preLetStatements clauses + goLetFunDefs clauses = maybe [] (toList . mkLetClauses) . nonEmpty <$> preLetStatements clauses where preLetStatements :: NonEmpty (LetStatement 'Scoped) -> Sem r [Internal.PreLetStatement] preLetStatements cl = mapMaybeM preLetStatement (toList cl) diff --git a/src/Juvix/Compiler/Internal/Translation/FromConcrete/NamedArguments.hs b/src/Juvix/Compiler/Internal/Translation/FromConcrete/NamedArguments.hs index 5e33ad87c5..1c1cfd8296 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromConcrete/NamedArguments.hs +++ b/src/Juvix/Compiler/Internal/Translation/FromConcrete/NamedArguments.hs @@ -137,7 +137,7 @@ helper loc = do (Implicit, Explicit) -> return mempty (ImplicitInstance, Explicit) -> return mempty - nextArgumentGroup :: Sem r (Maybe (IsImplicit, [NamedArgument 'Scoped], Bool)) + nextArgumentGroup :: Sem r (Maybe (IsImplicit, [NamedArgumentAssign 'Scoped], Bool)) nextArgumentGroup = do remb <- gets (^. stateRemainingArgs) case remb of @@ -149,8 +149,8 @@ helper loc = do modify' (set stateRemainingArgs rem') return (Just (impl, concatMap (toList . (^. argBlockArgs)) (b : c), isLastBlock)) - checkRepeated :: [NamedArgument 'Scoped] -> Sem r () - checkRepeated args = whenJust (nonEmpty (findRepeated (map (^. namedArgName) args))) $ \reps -> + checkRepeated :: [NamedArgumentAssign 'Scoped] -> Sem r () + checkRepeated args = whenJust (nonEmpty (findRepeated (map (^. namedArgName . S.nameConcrete) args))) $ \reps -> throw . ErrDuplicateArgument $ DuplicateArgument reps emitArgs :: IsImplicit -> Bool -> NamesByIndex -> [NameItem 'Scoped] -> IntMap Arg -> Sem r () @@ -231,8 +231,8 @@ helper loc = do scanGroup :: IsImplicit -> [NameItem 'Scoped] -> - [NamedArgument 'Scoped] -> - Sem r ([NamedArgument 'Scoped], ([NameItem 'Scoped], IntMap Arg)) + [NamedArgumentAssign 'Scoped] -> + Sem r ([NamedArgumentAssign 'Scoped], ([NameItem 'Scoped], IntMap Arg)) scanGroup impl names = fmap (second (first toList)) . runOutputList @@ -243,11 +243,11 @@ helper loc = do namesBySymbol :: HashMap Symbol (NameItem 'Scoped) namesBySymbol = HashMap.fromList [(symbolParsed (i ^. nameItemSymbol), i) | i <- names] go :: - (Members '[State (IntMap Arg), State (HashMap Symbol (NameItem 'Scoped)), State BuilderState, Output (NamedArgument 'Scoped), Error NamedArgumentsError] r') => - NamedArgument 'Scoped -> + (Members '[State (IntMap Arg), State (HashMap Symbol (NameItem 'Scoped)), State BuilderState, Output (NamedArgumentAssign 'Scoped), Error NamedArgumentsError] r') => + NamedArgumentAssign 'Scoped -> Sem r' () go arg = do - let sym = arg ^. namedArgName + let sym = arg ^. namedArgName . S.nameConcrete midx :: Maybe (NameItem 'Scoped) <- gets @(HashMap Symbol (NameItem 'Scoped)) (^. at sym) case midx of Just idx -> do diff --git a/src/Juvix/Compiler/Internal/Translation/FromConcrete/NamedArguments/Error.hs b/src/Juvix/Compiler/Internal/Translation/FromConcrete/NamedArguments/Error.hs index b9c5c4b141..73d492e283 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromConcrete/NamedArguments/Error.hs +++ b/src/Juvix/Compiler/Internal/Translation/FromConcrete/NamedArguments/Error.hs @@ -39,7 +39,7 @@ instance ToGenericError DuplicateArgument where return GenericError {..} newtype UnexpectedArguments = UnexpectedArguments - { _unexpectedArguments :: NonEmpty (NamedArgument 'Scoped) + { _unexpectedArguments :: NonEmpty (NamedArgumentAssign 'Scoped) } deriving stock (Show) diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader/Versions.hs b/src/Juvix/Compiler/Pipeline/Package/Loader/Versions.hs index 594f6b16b2..9eb15b7a3b 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader/Versions.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader/Versions.hs @@ -110,7 +110,7 @@ v1v2FromPackage p = run . runReader l $ do defaultPackageNoArgs :: (Member (Reader Interval) r) => Sem r (NonEmpty (ExpressionAtom 'Parsed)) defaultPackageNoArgs = NEL.singleton <$> identifier defaultPackageStr - defaultPackageWithArgs :: (Member (Reader Interval) r) => NonEmpty (NamedArgument 'Parsed) -> Sem r (NonEmpty (ExpressionAtom 'Parsed)) + defaultPackageWithArgs :: (Member (Reader Interval) r) => NonEmpty (NamedArgumentAssign 'Parsed) -> Sem r (NonEmpty (ExpressionAtom 'Parsed)) defaultPackageWithArgs as = do defaultPackageName' <- NameUnqualified <$> symbol defaultPackageStr argBlock <- argumentBlock Implicit as @@ -120,18 +120,18 @@ v1v2FromPackage p = run . runReader l $ do l :: Interval l = singletonInterval (mkInitialLoc (p ^. packageFile)) - mkNamedArgs :: forall r. (Member (Reader Interval) r) => Sem r [NamedArgument 'Parsed] + mkNamedArgs :: forall r. (Member (Reader Interval) r) => Sem r [NamedArgumentAssign 'Parsed] mkNamedArgs = do catMaybes <$> sequence [mkNameArg, mkVersionArg, mkDependenciesArg, mkMainArg, mkBuildDirArg] where - mkNameArg :: Sem r (Maybe (NamedArgument 'Parsed)) + mkNameArg :: Sem r (Maybe (NamedArgumentAssign 'Parsed)) mkNameArg | defaultPackageName == p ^. packageName = return Nothing | otherwise = do n <- literalString (p ^. packageName) Just <$> namedArgument "name" (n :| []) - mkDependenciesArg :: Sem r (Maybe (NamedArgument 'Parsed)) + mkDependenciesArg :: Sem r (Maybe (NamedArgumentAssign 'Parsed)) mkDependenciesArg = do let deps = p ^. packageDependencies dependenciesArg = Just <$> mkDependenciesArg' (p ^. packageDependencies) @@ -142,7 +142,7 @@ v1v2FromPackage p = run . runReader l $ do | otherwise -> dependenciesArg _ -> dependenciesArg where - mkDependenciesArg' :: [Dependency] -> Sem r (NamedArgument 'Parsed) + mkDependenciesArg' :: [Dependency] -> Sem r (NamedArgumentAssign 'Parsed) mkDependenciesArg' ds = do deps <- mkList =<< mapM mkDependencyArg ds namedArgument "dependencies" (deps :| []) @@ -165,7 +165,7 @@ v1v2FromPackage p = run . runReader l $ do ) ) - mkMainArg :: Sem r (Maybe (NamedArgument 'Parsed)) + mkMainArg :: Sem r (Maybe (NamedArgumentAssign 'Parsed)) mkMainArg = do arg <- mapM mainArg (p ^. packageMain) mapM (namedArgument "main") arg @@ -173,7 +173,7 @@ v1v2FromPackage p = run . runReader l $ do mainArg :: Prepath File -> Sem r (NonEmpty (ExpressionAtom 'Parsed)) mainArg p' = mkJust =<< literalString (pack (unsafePrepathToFilePath p')) - mkBuildDirArg :: Sem r (Maybe (NamedArgument 'Parsed)) + mkBuildDirArg :: Sem r (Maybe (NamedArgumentAssign 'Parsed)) mkBuildDirArg = do arg <- mapM buildDirArg (p ^. packageBuildDir) mapM (namedArgument "buildDir") arg @@ -181,12 +181,12 @@ v1v2FromPackage p = run . runReader l $ do buildDirArg :: SomeBase Dir -> Sem r (NonEmpty (ExpressionAtom 'Parsed)) buildDirArg d = mkJust =<< literalString (pack (fromSomeDir d)) - mkVersionArg :: Sem r (Maybe (NamedArgument 'Parsed)) + mkVersionArg :: Sem r (Maybe (NamedArgumentAssign 'Parsed)) mkVersionArg | p ^. packageVersion == defaultVersion = return Nothing | otherwise = Just <$> mkVersionArg' where - mkVersionArg' :: Sem r (NamedArgument 'Parsed) + mkVersionArg' :: Sem r (NamedArgumentAssign 'Parsed) mkVersionArg' = do mkVersionArgs <- liftM2 (++) explicitArgs implicitArgs mkVersionName <- identifier "mkVersion" diff --git a/src/Juvix/Prelude.hs b/src/Juvix/Prelude.hs index 27593976a7..58535957ee 100644 --- a/src/Juvix/Prelude.hs +++ b/src/Juvix/Prelude.hs @@ -2,6 +2,7 @@ module Juvix.Prelude ( module Juvix.Prelude.Base, module Juvix.Prelude.Lens, module Juvix.Prelude.Stream, + module Juvix.Prelude.Generic, module Juvix.Prelude.Trace, module Juvix.Prelude.Path, module Juvix.Prelude.Prepath, @@ -11,6 +12,7 @@ where import Juvix.Data import Juvix.Prelude.Base +import Juvix.Prelude.Generic import Juvix.Prelude.Lens import Juvix.Prelude.Path import Juvix.Prelude.Prepath diff --git a/src/Juvix/Prelude/Generic.hs b/src/Juvix/Prelude/Generic.hs new file mode 100644 index 0000000000..af2176a0e1 --- /dev/null +++ b/src/Juvix/Prelude/Generic.hs @@ -0,0 +1,33 @@ +module Juvix.Prelude.Generic + ( genericConstructorName, + genericSameConstructor, + GenericHasConstructor, + ) +where + +import GHC.Generics qualified as G +import Juvix.Prelude.Base.Foundation + +genericSameConstructor :: (Generic a, GenericHasConstructor (G.Rep a)) => a -> a -> Bool +genericSameConstructor x y = genericConstructorName @String x == genericConstructorName y + +genericConstructorName :: + forall str a. + (GenericHasConstructor (G.Rep a), Generic a, IsString str) => + a -> + str +genericConstructorName = fromString . genericConstrName . G.from + +class GenericHasConstructor (f :: GHCType -> GHCType) where + genericConstrName :: f x -> String + +instance (GenericHasConstructor f) => GenericHasConstructor (G.D1 c f) where + genericConstrName (G.M1 x) = genericConstrName x + +instance (GenericHasConstructor x, GenericHasConstructor y) => GenericHasConstructor (x G.:+: y) where + genericConstrName = \case + G.L1 l -> genericConstrName l + G.R1 r -> genericConstrName r + +instance (G.Constructor c) => GenericHasConstructor (G.C1 c f) where + genericConstrName x = G.conName x diff --git a/test/Base.hs b/test/Base.hs index f3ace57c86..8549e6f7f1 100644 --- a/test/Base.hs +++ b/test/Base.hs @@ -13,6 +13,7 @@ where import Control.Monad.Extra as Monad import Data.Algorithm.Diff import Data.Algorithm.DiffOutput +import GHC.Generics qualified as GHC import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.Termination import Juvix.Compiler.Pipeline.EntryPoint.IO import Juvix.Compiler.Pipeline.Loader.PathResolver @@ -21,6 +22,7 @@ import Juvix.Data.Effect.TaggedLock import Juvix.Extra.Paths hiding (rootBuildDir) import Juvix.Prelude hiding (assert) import Juvix.Prelude.Env +import Juvix.Prelude.Pretty (prettyString) import Parallel.ProgressLog import System.Process qualified as P import Test.Tasty @@ -125,6 +127,28 @@ testRunIOEitherTermination entry = assertFailure :: (MonadIO m) => String -> m a assertFailure = liftIO . HUnit.assertFailure +wantsError :: + forall err b. + (Generic err, GenericHasConstructor (GHC.Rep err)) => + (b -> err) -> + Path Abs File -> + err -> + Maybe String +wantsError wanted file actualErr + | genericSameConstructor wantedErr actualErr = Nothing + | otherwise = + Just + ( "In " + <> prettyString file + <> "\nExpected " + <> genericConstructorName wantedErr + <> "\nFound " + <> genericConstructorName actualErr + ) + where + wantedErr :: err + wantedErr = wanted impossible + -- | The same as `P.readProcess` but instead of inheriting `stderr` redirects it -- to the child's `stdout`. readProcess :: FilePath -> [String] -> Text -> IO Text diff --git a/test/Scope/Negative.hs b/test/Scope/Negative.hs index 15845e96f6..23eb740d7b 100644 --- a/test/Scope/Negative.hs +++ b/test/Scope/Negative.hs @@ -27,7 +27,7 @@ testDescr NegTest {..} = res <- testRunIOEitherTermination entryPoint upToInternal case mapLeft fromJuvixError res of Left (Just err) -> whenJust (_checkErr err) assertFailure - Left Nothing -> assertFailure "An error occurred but it was not in the scoper." + Left Nothing -> assertFailure ("An error occurred but it was not in the scoper.\nFile: " <> prettyString file') Right {} -> assertFailure "The scope checker did not find an error." } @@ -38,352 +38,260 @@ allTests = ( map (mkTest . testDescr) scoperErrorTests ) -wrongError :: Maybe FailMsg -wrongError = Just "Incorrect error" +negTest :: + String -> + Path Rel Dir -> + Path Rel File -> + (Path Abs File -> ScoperError -> Maybe FailMsg) -> + NegTest ScoperError +negTest tname rdir rfile chk = + NegTest + { _name = tname, + _relDir = rdir, + _file = rfile, + _checkErr = chk (root rdir rfile) + } scoperErrorTests :: [NegTest ScoperError] scoperErrorTests = - [ NegTest + [ negTest "Not in scope" $(mkRelDir ".") $(mkRelFile "NotInScope.juvix") - $ \case - ErrSymNotInScope {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrSymNotInScope, + negTest "Qualified not in scope" $(mkRelDir ".") $(mkRelFile "QualSymNotInScope.juvix") - $ \case - ErrQualSymNotInScope {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrQualSymNotInScope, + negTest "Multiple declarations" $(mkRelDir ".") $(mkRelFile "MultipleDeclarations.juvix") - $ \case - ErrMultipleDeclarations {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrMultipleDeclarations, + negTest "Import cycle" $(mkRelDir "ImportCycle") $(mkRelFile "A.juvix") - $ \case - ErrImportCycleNew {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrImportCycleNew, + negTest "Binding group conflict (function clause)" $(mkRelDir "BindGroupConflict") $(mkRelFile "Clause.juvix") - $ \case - ErrMultipleDeclarations {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrMultipleDeclarations, + negTest "Binding group conflict (lambda clause)" $(mkRelDir "BindGroupConflict") $(mkRelFile "Lambda.juvix") - $ \case - ErrMultipleDeclarations {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrMultipleDeclarations, + negTest "Infix error (expression)" $(mkRelDir ".") $(mkRelFile "InfixError.juvix") - $ \case - ErrInfixParser {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrInfixParser, + negTest "Infix error (pattern)" $(mkRelDir ".") $(mkRelFile "InfixErrorP.juvix") - $ \case - ErrInfixPattern {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrInfixPattern, + negTest "Duplicate operator declaration" $(mkRelDir ".") $(mkRelFile "DuplicateOperator.juvix") - $ \case - ErrDuplicateOperator {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrDuplicateOperator, + negTest "Multiple export conflict" $(mkRelDir ".") $(mkRelFile "MultipleExportConflict.juvix") - $ \case - ErrMultipleExport {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrMultipleExport, + negTest "Module not in scope" $(mkRelDir ".") $(mkRelFile "ModuleNotInScope.juvix") - $ \case - ErrModuleNotInScope {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrModuleNotInScope, + negTest "Unused operator syntax definition" $(mkRelDir ".") $(mkRelFile "UnusedOperatorDef.juvix") - $ \case - ErrUnusedOperatorDef {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrUnusedOperatorDef, + negTest "Ambiguous symbol" $(mkRelDir ".") $(mkRelFile "AmbiguousSymbol.juvix") - $ \case - ErrAmbiguousSym {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrAmbiguousSym, + negTest "Ambiguous export" $(mkRelDir ".") $(mkRelFile "AmbiguousExport.juvix") - $ \case - ErrMultipleExport {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrMultipleExport, + negTest "Ambiguous nested modules" $(mkRelDir ".") $(mkRelFile "AmbiguousModule.juvix") - $ \case - ErrAmbiguousModuleSym {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrAmbiguousModuleSym, + negTest "Ambiguous nested constructors" $(mkRelDir ".") $(mkRelFile "AmbiguousConstructor.juvix") - $ \case - ErrAmbiguousSym {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrAmbiguousSym, + negTest "Implicit argument on the left of an application" $(mkRelDir ".") $(mkRelFile "AppLeftImplicit.juvix") - $ \case - ErrAppLeftImplicit {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrAppLeftImplicit, + negTest "issue 230" $(mkRelDir "230") $(mkRelFile "Prod.juvix") - $ \case - ErrQualSymNotInScope {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrQualSymNotInScope, + negTest "Double braces in pattern" $(mkRelDir ".") $(mkRelFile "NestedPatternBraces.juvix") - $ \case - ErrDoubleBracesPattern {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrDoubleBracesPattern, + negTest "As-Pattern aliasing variable" $(mkRelDir ".") $(mkRelFile "AsPatternAlias.juvix") - $ \case - ErrAliasBinderPattern {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrAliasBinderPattern, + negTest "Nested As-Patterns" $(mkRelDir ".") $(mkRelFile "NestedAsPatterns.juvix") - $ \case - ErrDoubleBinderPattern {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrDoubleBinderPattern, + negTest "Pattern matching an implicit argument on the left of an application" $(mkRelDir ".") $(mkRelFile "ImplicitPatternLeftApplication.juvix") - $ \case - ErrImplicitPatternLeftApplication {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrImplicitPatternLeftApplication, + negTest "Constructor expected on the left of a pattern application" $(mkRelDir ".") $(mkRelFile "ConstructorExpectedLeftApplication.juvix") - $ \case - ErrConstructorExpectedLeftApplication {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrConstructorExpectedLeftApplication, + negTest "A type parameter name occurs twice when declaring an inductive type" $(mkRelDir ".") $(mkRelFile "DuplicateInductiveParameterName.juvix") - $ \case - ErrNameSignature (ErrDuplicateName DuplicateName {}) -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrNameSignature, + negTest "Using symbol that is not exported" $(mkRelDir "UsingHiding") $(mkRelFile "Main.juvix") - $ \case - ErrModuleDoesNotExportSymbol {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrModuleDoesNotExportSymbol, + negTest "Wrong number of iterator initializers" $(mkRelDir ".") $(mkRelFile "Iterators1.juvix") - $ \case - ErrIteratorInitializer {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrIteratorInitializer, + negTest "Wrong number of iterator ranges" $(mkRelDir ".") $(mkRelFile "Iterators2.juvix") - $ \case - ErrIteratorRange {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrIteratorRange, + negTest "Undeclared iterator" $(mkRelDir ".") $(mkRelFile "Iterators3.juvix") - $ \case - ErrIteratorUndefined {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrIteratorUndefined, + negTest "Duplicate iterator declaration" $(mkRelDir ".") $(mkRelFile "Iterators4.juvix") - $ \case - ErrDuplicateIterator {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrDuplicateIterator, + negTest "Unused iterator declaration" $(mkRelDir ".") $(mkRelFile "Iterators5.juvix") - $ \case - ErrUnusedIteratorDef {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrUnusedIteratorDef, + negTest "Repeated name in named application" $(mkRelDir ".") $(mkRelFile "DuplicateArgument.juvix") - $ \case - ErrNamedArgumentsError (ErrDuplicateArgument {}) -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrMultipleDeclarations, + negTest "Unexpected named argument after wildcard" $(mkRelDir ".") $(mkRelFile "UnexpectedArgumentWildcard.juvix") - $ \case - ErrNamedArgumentsError ErrUnexpectedArguments {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrUnexpectedArgument, + negTest "Unexpected named argument" $(mkRelDir ".") $(mkRelFile "UnexpectedArgument.juvix") - $ \case - ErrNamedArgumentsError ErrUnexpectedArguments {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrUnexpectedArgument, + negTest "Missing argument" $(mkRelDir ".") $(mkRelFile "MissingArgument.juvix") - $ \case - ErrNamedArgumentsError ErrMissingArguments {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrNamedArgumentsError, + negTest "Repeated name in name signature" $(mkRelDir ".") $(mkRelFile "RepeatedNameSignature.juvix") - $ \case - ErrNameSignature ErrDuplicateName {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrNameSignature, + negTest "No named arguments" $(mkRelDir ".") $(mkRelFile "NoNamedArguments.juvix") - $ \case - ErrNamedArgumentsError ErrUnexpectedArguments {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrNoNameSignature, + negTest "Not a record" $(mkRelDir ".") $(mkRelFile "NotARecord.juvix") - $ \case - ErrNotARecord NotARecord {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrNotARecord, + negTest "Unexpected field in record update" $(mkRelDir ".") $(mkRelFile "UnexpectedFieldUpdate.juvix") - $ \case - ErrUnexpectedField UnexpectedField {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrUnexpectedField, + negTest "Repeated field in record pattern" $(mkRelDir ".") $(mkRelFile "RepeatedFieldPattern.juvix") - $ \case - ErrRepeatedField RepeatedField {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrRepeatedField, + negTest "Missing fields in record creation" $(mkRelDir ".") $(mkRelFile "MissingFields.juvix") - $ \case - ErrMissingArgs {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrMissingArgs, + negTest "Unexpected argument" $(mkRelDir ".") $(mkRelFile "UnexpectedArgumentNew.juvix") - $ \case - ErrUnexpectedArgument UnexpectedArgument {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrUnexpectedArgument, + negTest "Incomparable precedences" $(mkRelDir ".") $(mkRelFile "IncomparablePrecedences.juvix") - $ \case - ErrIncomparablePrecedences {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrIncomparablePrecedences, + negTest "Precedence inconsistency" $(mkRelDir ".") $(mkRelFile "PrecedenceInconsistency.juvix") - $ \case - ErrPrecedenceInconsistency {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrPrecedenceInconsistency, + negTest "Alias cycle" $(mkRelDir ".") $(mkRelFile "AliasCycle.juvix") - $ \case - ErrAliasCycle {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrAliasCycle, + negTest "Invalid range number in iterator definition" $(mkRelDir ".") $(mkRelFile "InvalidRangeNumber.juvix") - $ \case - ErrInvalidRangeNumber {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrInvalidRangeNumber, + negTest "Dangling double brace" $(mkRelDir "Internal") $(mkRelFile "DanglingDoubleBrace.juvix") - $ \case - ErrDanglingDoubleBrace {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrDanglingDoubleBrace, + negTest "Nested let open shadowing" $(mkRelDir ".") $(mkRelFile "LetOpen.juvix") - $ \case - ErrAmbiguousSym {} -> Nothing - _ -> wrongError, - NegTest + $ wantsError ErrAmbiguousSym, + negTest "Invalid default" $(mkRelDir ".") $(mkRelFile "InvalidDefault.juvix") - $ \case - ErrWrongDefaultValue {} -> Nothing - _ -> wrongError, - NegTest - "Default argument cycle in FromConcrete" - $(mkRelDir ".") - $(mkRelFile "DefaultArgCycle.juvix") - $ \case - ErrDefaultArgCycle {} -> Nothing - _ -> wrongError + $ wantsError ErrWrongDefaultValue ] diff --git a/tests/Anoma/Compilation/positive/Package.juvix b/tests/Anoma/Compilation/positive/Package.juvix index 0a97a86198..2f2f7969e7 100644 --- a/tests/Anoma/Compilation/positive/Package.juvix +++ b/tests/Anoma/Compilation/positive/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {name := "positive"}; +package : Package := + defaultPackage@?{ + name := "positive" + }; diff --git a/tests/Anoma/Compilation/positive/test067.juvix b/tests/Anoma/Compilation/positive/test067.juvix index c9fb065f98..5c1b90d87d 100644 --- a/tests/Anoma/Compilation/positive/test067.juvix +++ b/tests/Anoma/Compilation/positive/test067.juvix @@ -5,4 +5,7 @@ import Stdlib.Data.Nat open; f {a : Nat := 2} {b : Nat := a + 1} {c : Nat} : Nat := a * b * c; -main : Nat := f {c := 5}; +main : Nat := + f@?{ + c := 5 + }; diff --git a/tests/Anoma/Compilation/positive/test069.juvix b/tests/Anoma/Compilation/positive/test069.juvix index 8e31e48d98..98d49c65fe 100644 --- a/tests/Anoma/Compilation/positive/test069.juvix +++ b/tests/Anoma/Compilation/positive/test069.juvix @@ -20,10 +20,12 @@ mkOrdHelper (cmp : A -> A -> Ordering) {lt : A -> A -> Bool := λ {a b := isLT (cmp a b)}} {gt : A -> A -> Bool := λ {a b := isGT (cmp a b)}} - : Ord A := - mkOrd cmp lt gt; + : Ord A := mkOrd cmp lt gt; -ordNatNamed : Ord Nat := mkOrdHelper (cmp := Ord.compare); +ordNatNamed : Ord Nat := + mkOrdHelper@?{ + cmp := Ord.compare + }; instance ordNat : Ord Nat := mkOrdHelper Ord.compare; diff --git a/tests/Anoma/Compilation/positive/test070.juvix b/tests/Anoma/Compilation/positive/test070.juvix index 171cf12e8b..9a9b0f653e 100644 --- a/tests/Anoma/Compilation/positive/test070.juvix +++ b/tests/Anoma/Compilation/positive/test070.juvix @@ -3,8 +3,16 @@ module test070; import Stdlib.Data.Nat open; -fun {a : Nat := 1} {b : Nat := a + 1} {c : Nat := b + a + 1} - : Nat := a * b + c; +fun {a : Nat := 1} {b : Nat := a + 1} {c : Nat := b + a + 1} : Nat := a * b + c; main : Nat := - fun {a := fun; b := fun {b := 3} * fun {b := fun {2}}}; + fun@?{ + a := fun; + b := + fun@?{ + b := 3 + } + * fun@?{ + b := fun {2} + } + }; diff --git a/tests/Anoma/Compilation/positive/test072/Package.juvix b/tests/Anoma/Compilation/positive/test072/Package.juvix index d86c375987..16589dc288 100644 --- a/tests/Anoma/Compilation/positive/test072/Package.juvix +++ b/tests/Anoma/Compilation/positive/test072/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {name := "monads"}; +package : Package := + defaultPackage@?{ + name := "monads" + }; diff --git a/tests/Anoma/Compilation/positive/test073/Package.juvix b/tests/Anoma/Compilation/positive/test073/Package.juvix index 905b22a801..eec3c8b6d8 100644 --- a/tests/Anoma/Compilation/positive/test073/Package.juvix +++ b/tests/Anoma/Compilation/positive/test073/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {name := "test073"}; +package : Package := + defaultPackage@?{ + name := "test073" + }; diff --git a/tests/Casm/Compilation/positive/test067.juvix b/tests/Casm/Compilation/positive/test067.juvix index c9fb065f98..5c1b90d87d 100644 --- a/tests/Casm/Compilation/positive/test067.juvix +++ b/tests/Casm/Compilation/positive/test067.juvix @@ -5,4 +5,7 @@ import Stdlib.Data.Nat open; f {a : Nat := 2} {b : Nat := a + 1} {c : Nat} : Nat := a * b * c; -main : Nat := f {c := 5}; +main : Nat := + f@?{ + c := 5 + }; diff --git a/tests/Casm/Compilation/positive/test069.juvix b/tests/Casm/Compilation/positive/test069.juvix index e5ec4e3f72..ae81285b3c 100644 --- a/tests/Casm/Compilation/positive/test069.juvix +++ b/tests/Casm/Compilation/positive/test069.juvix @@ -20,10 +20,12 @@ mkOrdHelper (cmp : A -> A -> Ordering) {lt : A -> A -> Bool := λ {a b := isLT (cmp a b)}} {gt : A -> A -> Bool := λ {a b := isGT (cmp a b)}} - : Ord A := - mkOrd cmp lt gt; + : Ord A := mkOrd cmp lt gt; -ordNatNamed : Ord Nat := mkOrdHelper (cmp := Ord.compare); +ordNatNamed : Ord Nat := + mkOrdHelper@?{ + cmp := Ord.compare + }; instance ordNat : Ord Nat := mkOrdHelper Ord.compare; diff --git a/tests/Casm/Compilation/positive/test070.juvix b/tests/Casm/Compilation/positive/test070.juvix index 171cf12e8b..9a9b0f653e 100644 --- a/tests/Casm/Compilation/positive/test070.juvix +++ b/tests/Casm/Compilation/positive/test070.juvix @@ -3,8 +3,16 @@ module test070; import Stdlib.Data.Nat open; -fun {a : Nat := 1} {b : Nat := a + 1} {c : Nat := b + a + 1} - : Nat := a * b + c; +fun {a : Nat := 1} {b : Nat := a + 1} {c : Nat := b + a + 1} : Nat := a * b + c; main : Nat := - fun {a := fun; b := fun {b := 3} * fun {b := fun {2}}}; + fun@?{ + a := fun; + b := + fun@?{ + b := 3 + } + * fun@?{ + b := fun {2} + } + }; diff --git a/tests/Casm/Compilation/positive/test072/Package.juvix b/tests/Casm/Compilation/positive/test072/Package.juvix index d86c375987..16589dc288 100644 --- a/tests/Casm/Compilation/positive/test072/Package.juvix +++ b/tests/Casm/Compilation/positive/test072/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {name := "monads"}; +package : Package := + defaultPackage@?{ + name := "monads" + }; diff --git a/tests/Casm/Compilation/positive/test073/Package.juvix b/tests/Casm/Compilation/positive/test073/Package.juvix index 905b22a801..eec3c8b6d8 100644 --- a/tests/Casm/Compilation/positive/test073/Package.juvix +++ b/tests/Casm/Compilation/positive/test073/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {name := "test073"}; +package : Package := + defaultPackage@?{ + name := "test073" + }; diff --git a/tests/Compilation/positive/test006.juvix b/tests/Compilation/positive/test006.juvix index 4d8ae8376f..40aba0879b 100644 --- a/tests/Compilation/positive/test006.juvix +++ b/tests/Compilation/positive/test006.juvix @@ -8,6 +8,7 @@ loop : Nat := loop; main : IO := printNatLn - (ite (3 > 0) 1 loop + ite (2 < 1) loop (ite (7 >= 8) loop 1)) + (ite (3 > 0) 1 loop + + ite (2 < 1) loop (ite (7 >= 8) loop 1)) >>> printBoolLn (2 > 0 || loop == 0) >>> printBoolLn (2 < 0 && loop == 0); diff --git a/tests/Compilation/positive/test007.juvix b/tests/Compilation/positive/test007.juvix index 300836c2fa..054198abb3 100644 --- a/tests/Compilation/positive/test007.juvix +++ b/tests/Compilation/positive/test007.juvix @@ -31,4 +31,5 @@ main : IO := >>> printNatLn (head 0 (tail lst)) >>> printNatListLn (map ((+) 1) lst) >>> printNatListLn (map' ((+) 1) lst) - >>> printNatListLn (runPartial (λ{{{_}} := map'' ((+) 1) lst})); + >>> printNatListLn + (runPartial λ {{{_}} := map'' ((+) 1) lst}); diff --git a/tests/Compilation/positive/test010.juvix b/tests/Compilation/positive/test010.juvix index d09b01f2c8..05f7129d30 100644 --- a/tests/Compilation/positive/test010.juvix +++ b/tests/Compilation/positive/test010.juvix @@ -7,16 +7,15 @@ main : IO := let x : Nat := 1; in let - x1 : - Nat := - x - + let - x2 : Nat := 2; - in x2; - in let - x3 : Nat := x1 * x1; - in let - y : Nat := x3 + 2; - in let - z : Nat := x3 + y; - in printNatLn (x + y + z); + x1 : Nat := + x + + let + x2 : Nat := 2; + in x2; + in let + x3 : Nat := x1 * x1; + in let + y : Nat := x3 + 2; + in let + z : Nat := x3 + y; + in printNatLn (x + y + z); diff --git a/tests/Compilation/positive/test012.juvix b/tests/Compilation/positive/test012.juvix index 529cfe7b60..2bed6bb25e 100644 --- a/tests/Compilation/positive/test012.juvix +++ b/tests/Compilation/positive/test012.juvix @@ -16,7 +16,8 @@ gen : Nat → Tree if | mod n 3 == 0 := node1 (gen (sub n 1)) | mod n 3 == 1 := node2 (gen (sub n 1)) (gen (sub n 1)) - | else := node3 (gen (sub n 1)) (gen (sub n 1)) (gen (sub n 1)); + | else := + node3 (gen (sub n 1)) (gen (sub n 1)) (gen (sub n 1)); preorder : Tree → IO | leaf := printNat 0 diff --git a/tests/Compilation/positive/test018.juvix b/tests/Compilation/positive/test018.juvix index 1fc723b20e..c8d3f4fe47 100644 --- a/tests/Compilation/positive/test018.juvix +++ b/tests/Compilation/positive/test018.juvix @@ -13,4 +13,3 @@ u : Nat → Nat | x := f (h 4) + x; main : IO := printNatLn (u 2); - diff --git a/tests/Compilation/positive/test019.juvix b/tests/Compilation/positive/test019.juvix index f87c6c752a..431f3b8317 100644 --- a/tests/Compilation/positive/test019.juvix +++ b/tests/Compilation/positive/test019.juvix @@ -8,4 +8,3 @@ app : ({A : Type} → A → A) → {A : Type} → A → A | x := x x; main : IO := printNatLn (app id (3 + 4)); - diff --git a/tests/Compilation/positive/test022.juvix b/tests/Compilation/positive/test022.juvix index 209802296d..15f70da338 100644 --- a/tests/Compilation/positive/test022.juvix +++ b/tests/Compilation/positive/test022.juvix @@ -25,4 +25,3 @@ main : IO := >>> printListNatLn (reverse (map (flip sub 1) (gen 10))) >>> printNatLn (sum 10000) >>> printNatLn (sum' 10000); - diff --git a/tests/Compilation/positive/test023.juvix b/tests/Compilation/positive/test023.juvix index c740ff35a3..e253e2f021 100644 --- a/tests/Compilation/positive/test023.juvix +++ b/tests/Compilation/positive/test023.juvix @@ -20,4 +20,3 @@ main : IO := printNatLn (f 5) >>> printNatLn (f 10) >>> printNatLn (f 20); - diff --git a/tests/Compilation/positive/test027.juvix b/tests/Compilation/positive/test027.juvix index 011f94af02..0758f8218c 100644 --- a/tests/Compilation/positive/test027.juvix +++ b/tests/Compilation/positive/test027.juvix @@ -1,33 +1,35 @@ --- Church numerals +--- Church numerals +--- This test is disabled until https://github.com/anoma/juvix/issues/1706 is fixed. +--- It is convenient to comment it out so we can format all test files without a crash. module test027; -import Stdlib.Prelude open hiding {toNat}; +-- import Stdlib.Prelude open hiding {toNat}; -Num : Type := {A : Type} → (A → A) → A → A; +-- Num : Type := {A : Type} → (A → A) → A → A; -czero : Num - | {_} f x := x; +-- czero : Num +-- | {_} f x := x; -csuc : Num → Num - | n {_} f := f << n {_} f; +-- csuc : Num → Num +-- | n {_} f := f << n {_} f; -num : Nat → Num - | zero := czero - | (suc n) := csuc (num n); +-- num : Nat → Num +-- | zero := czero +-- | (suc n) := csuc (num n); -add : Num → Num → Num - | n m {_} f := n {_} f << m {_} f; +-- add : Num → Num → Num +-- | n m {_} f := n {_} f << m {_} f; -mul : Num → Num → Num - | n m {_} := n {_} << m {_}; +-- mul : Num → Num → Num +-- | n m {_} := n {_} << m {_}; -isZero : Num → Bool - | n := n {_} (const false) true; +-- isZero : Num → Bool +-- | n := n {_} (const false) true; -toNat : Num → Nat - | n := n {_} ((+) 1) 0; +-- toNat : Num → Nat +-- | n := n {_} ((+) 1) 0; -main : IO := - printNatLn (toNat (num 7)) - >>> printNatLn (toNat (add (num 7) (num 3))) - >>> printNatLn (toNat (mul (num 7) (num 3))); +-- main : IO := +-- printNatLn (toNat (num 7)) +-- >>> printNatLn (toNat (add (num 7) (num 3))) +-- >>> printNatLn (toNat (mul (num 7) (num 3))); diff --git a/tests/Compilation/positive/test030.juvix b/tests/Compilation/positive/test030.juvix index 06d31084b6..105c9fe2a8 100644 --- a/tests/Compilation/positive/test030.juvix +++ b/tests/Compilation/positive/test030.juvix @@ -25,4 +25,3 @@ main : IO := >>> printNatLn (mult 3 7) >>> printNatLn (exp 3 7) >>> printNatLn (ackermann 3 7); - diff --git a/tests/Compilation/positive/test035.juvix b/tests/Compilation/positive/test035.juvix index 2d168a1c07..463330ce92 100644 --- a/tests/Compilation/positive/test035.juvix +++ b/tests/Compilation/positive/test035.juvix @@ -55,4 +55,3 @@ main : IO := >>> printNatLn (f (gen 20)) >>> printNatLn (h 5) >>> printNatLn (h 3); - diff --git a/tests/Compilation/positive/test036.juvix b/tests/Compilation/positive/test036.juvix index 68e57d7a06..b7fc7863c2 100644 --- a/tests/Compilation/positive/test036.juvix +++ b/tests/Compilation/positive/test036.juvix @@ -21,4 +21,3 @@ j : Nat → Nat → Nat := g'; k : Nat → Nat → Nat → Nat := expand j; main : IO := printNatLn (h 13 + j 2 3 + k 9 4 7); - diff --git a/tests/Compilation/positive/test037.juvix b/tests/Compilation/positive/test037.juvix index 3b67e2dc3d..e73ae55529 100644 --- a/tests/Compilation/positive/test037.juvix +++ b/tests/Compilation/positive/test037.juvix @@ -10,12 +10,12 @@ f (l : List ((Nat → Nat) → Nat → Nat)) : Nat := } (let y : Nat → Nat := id; - in (let + in let z : (Nat → Nat) → Nat → Nat := id; - in case l of + in case l of { | _ :: _ := id - | _ := id - z) + | _ := id z + } y) 7; diff --git a/tests/Compilation/positive/test040.juvix b/tests/Compilation/positive/test040.juvix index 0b7d6d21e3..bae5ca1bbf 100644 --- a/tests/Compilation/positive/test040.juvix +++ b/tests/Compilation/positive/test040.juvix @@ -4,11 +4,9 @@ module test040; import Stdlib.System.IO open; import Stdlib.Data.Bool open; -type Unit := - | unit : Unit; +type Unit := unit : Unit; -type Foo (A : Type) := - | foo : Unit -> A -> Foo A; +type Foo (A : Type) := foo : Unit -> A -> Foo A; f : {A : Type} -> Foo A -> A | (foo unit a) := a; diff --git a/tests/Compilation/positive/test041.juvix b/tests/Compilation/positive/test041.juvix index 2b611d4db7..f6f6a4e0e9 100644 --- a/tests/Compilation/positive/test041.juvix +++ b/tests/Compilation/positive/test041.juvix @@ -3,8 +3,7 @@ module test041; import Stdlib.Prelude open; -type BoxedString := - | boxed : String -> BoxedString; +type BoxedString := boxed : String -> BoxedString; printBoxedString : BoxedString -> IO | (boxed s) := printStringLn s; diff --git a/tests/Compilation/positive/test046.juvix b/tests/Compilation/positive/test046.juvix index ff692742fd..43f3af01a7 100644 --- a/tests/Compilation/positive/test046.juvix +++ b/tests/Compilation/positive/test046.juvix @@ -12,6 +12,7 @@ id' : Ty -- In PR https://github.com/anoma/juvix/pull/2545 we had to slightly modify -- the `fun` definition. The previous version is kept here as a comment. -- fun : {A : Type} → A → Ty := id λ {_ := id'}; -fun {A : Type} : A → Ty := id { _ -> {C : Type} → C → C } λ {_ := id'}; +fun {A : Type} : A → Ty := + id {_ -> {C : Type} → C → C} λ {_ := id'}; main : Nat := fun 5 {Nat} 7; diff --git a/tests/Compilation/positive/test055.juvix b/tests/Compilation/positive/test055.juvix index 120fb8a312..5fc3bdda96 100644 --- a/tests/Compilation/positive/test055.juvix +++ b/tests/Compilation/positive/test055.juvix @@ -3,8 +3,7 @@ module test055; import Stdlib.Prelude open; -type Pair' := - | pair : Nat -> Nat -> Pair'; +type Pair' := pair : Nat -> Nat -> Pair'; main : Pair (List (Pair Pair' Nat)) (List Pair') := (pair 1 2, 3) :: (pair 2 3, 4) :: nil diff --git a/tests/Compilation/positive/test060.juvix b/tests/Compilation/positive/test060.juvix index fe2fce2524..04e26f8f0b 100644 --- a/tests/Compilation/positive/test060.juvix +++ b/tests/Compilation/positive/test060.juvix @@ -33,11 +33,10 @@ main : Triple Nat Nat Nat := (@Triple{fst := fst * 10}); in if | mf - mkPair@{ - fst := mkPair true nil; - snd := 0 :: nil - } := - (f p') + mkPair@{ + fst := mkPair true nil; + snd := 0 :: nil + } := f p' | else := mkTriple@{ fst := 0; diff --git a/tests/Compilation/positive/test061.juvix b/tests/Compilation/positive/test061.juvix index 999b67bf73..a1849f140e 100644 --- a/tests/Compilation/positive/test061.juvix +++ b/tests/Compilation/positive/test061.juvix @@ -7,10 +7,14 @@ trait type Show A := mkShow {show : A → String}; Show' : Type -> Type := Show; + Bool' : Type := Bool; instance -showStringI : Show String := mkShow (show := id); +showStringI : Show String := + mkShow@?{ + show := id + }; instance showBoolI : Show' Bool' := @@ -19,7 +23,10 @@ showBoolI : Show' Bool' := }; instance -showNatI : Show Nat := mkShow (show := natToString); +showNatI : Show Nat := + mkShow@?{ + show := natToString + }; g : {A : Type} → {{Show A}} → Nat := 5; @@ -52,46 +59,49 @@ f'3 {A} {{M : Show A}} : A → String := Show.show {{M}}; f'4 {A} {{_ : Show A}} : A → String := Show.show; -f5 {A} {{Show' A}} (n : String) (a : A) : String := - n ++str Show.show a; +f5 {A} {{Show' A}} (n : String) (a : A) : String := n ++str Show.show a; instance -showBoolFunI : Show (Bool → Bool) := mkShow@{ - show (f : Bool → Bool) : String := - let - b1 : Bool := f true; - b2 : Bool := f false; - in - "\\{ true := " ++str Show.show b1 ++str " | false := " ++str Show.show b2 ++str " }"; -}; +showBoolFunI : Show (Bool → Bool) := + mkShow@{ + show (f : Bool → Bool) : String := + let + b1 : Bool := f true; + b2 : Bool := f false; + in "\\{ true := " ++str Show.show b1 ++str " | false := " ++str Show.show b2 ++str " }" + }; instance showPairI {A B} {{Show A}} {{Show' B}} : Show' (Pair A B) := mkShow λ {(x, y) := Show.show x ++str ", " ++str Show.show y}; trait -type T A := mkT { a : A }; +type T A := mkT {a : A}; instance tNatI : T Nat := mkT 0; instance -tFunI {A} {{T A}} : T (A -> A) := mkT \ { a := a }; +tFunI {A} {{T A}} : T (A -> A) := mkT \ {a := a}; main : IO := - printStringLn (Show.show true) >>> - printStringLn (f false) >>> - printStringLn (Show.show 3) >>> - printStringLn (Show.show (g {Nat})) >>> - printStringLn (Show.show [true; false]) >>> - printStringLn (Show.show [1; 2; 3]) >>> - printStringLn (f' [1; 2]) >>> - printStringLn (f'' [true; false]) >>> - printStringLn (f'3 [just true; nothing; just false]) >>> - printStringLn (f'4 [just [1]; nothing; just [2; 3]]) >>> - printStringLn (f'3 "abba") >>> - printStringLn (f'3 {{M := mkShow (λ{x := x ++str "!"})}} "abba") >>> - printStringLn (f5 "abba" 3) >>> - printStringLn (Show.show {{_}} ["a"; "b"; "c"; "d"]) >>> - printStringLn (Show.show (λ{x := not x})) >>> - printStringLn (Show.show (3, [1; 2 + T.a 0])); + printStringLn (Show.show true) + >>> printStringLn (f false) + >>> printStringLn (Show.show 3) + >>> printStringLn (Show.show (g {Nat})) + >>> printStringLn (Show.show [true; false]) + >>> printStringLn (Show.show [1; 2; 3]) + >>> printStringLn (f' [1; 2]) + >>> printStringLn (f'' [true; false]) + >>> printStringLn (f'3 [just true; nothing; just false]) + >>> printStringLn (f'4 [just [1]; nothing; just [2; 3]]) + >>> printStringLn (f'3 "abba") + >>> printStringLn + (f'3@?{ + M := mkShow λ {x := x ++str "!"} + } + "abba") + >>> printStringLn (f5 "abba" 3) + >>> printStringLn (Show.show {{_}} ["a"; "b"; "c"; "d"]) + >>> printStringLn (Show.show λ {x := not x}) + >>> printStringLn (Show.show (3, [1; 2 + T.a 0])); diff --git a/tests/Compilation/positive/test064.juvix b/tests/Compilation/positive/test064.juvix index 84c964c5a9..7958c5ea30 100644 --- a/tests/Compilation/positive/test064.juvix +++ b/tests/Compilation/positive/test064.juvix @@ -36,6 +36,7 @@ even' : Nat -> Bool := even; main : Nat := sum 3 - + case even' 6 || g true || h true of + + case even' 6 || g true || h true of { | true := ite (g false) (f 1 2 + sum 7 + j 0) 0 - | false := f (3 + 4) (f 0 8) + loop; + | false := f (3 + 4) (f 0 8) + loop + }; diff --git a/tests/Compilation/positive/test067.juvix b/tests/Compilation/positive/test067.juvix index c9fb065f98..de3721c21d 100644 --- a/tests/Compilation/positive/test067.juvix +++ b/tests/Compilation/positive/test067.juvix @@ -3,6 +3,10 @@ module test067; import Stdlib.Data.Nat open; -f {a : Nat := 2} {b : Nat := a + 1} {c : Nat} : Nat := a * b * c; +f {a : Nat := 2} {b : Nat := a + 1} {c : Nat} : Nat := + a * b * c; -main : Nat := f {c := 5}; +main : Nat := + f@?{ + c := 5 + }; diff --git a/tests/Compilation/positive/test069.juvix b/tests/Compilation/positive/test069.juvix index 8e31e48d98..98d49c65fe 100644 --- a/tests/Compilation/positive/test069.juvix +++ b/tests/Compilation/positive/test069.juvix @@ -20,10 +20,12 @@ mkOrdHelper (cmp : A -> A -> Ordering) {lt : A -> A -> Bool := λ {a b := isLT (cmp a b)}} {gt : A -> A -> Bool := λ {a b := isGT (cmp a b)}} - : Ord A := - mkOrd cmp lt gt; + : Ord A := mkOrd cmp lt gt; -ordNatNamed : Ord Nat := mkOrdHelper (cmp := Ord.compare); +ordNatNamed : Ord Nat := + mkOrdHelper@?{ + cmp := Ord.compare + }; instance ordNat : Ord Nat := mkOrdHelper Ord.compare; diff --git a/tests/Compilation/positive/test070.juvix b/tests/Compilation/positive/test070.juvix index 171cf12e8b..9a9b0f653e 100644 --- a/tests/Compilation/positive/test070.juvix +++ b/tests/Compilation/positive/test070.juvix @@ -3,8 +3,16 @@ module test070; import Stdlib.Data.Nat open; -fun {a : Nat := 1} {b : Nat := a + 1} {c : Nat := b + a + 1} - : Nat := a * b + c; +fun {a : Nat := 1} {b : Nat := a + 1} {c : Nat := b + a + 1} : Nat := a * b + c; main : Nat := - fun {a := fun; b := fun {b := 3} * fun {b := fun {2}}}; + fun@?{ + a := fun; + b := + fun@?{ + b := 3 + } + * fun@?{ + b := fun {2} + } + }; diff --git a/tests/Compilation/positive/test071.juvix b/tests/Compilation/positive/test071.juvix index f5bd48deb0..3fce098625 100644 --- a/tests/Compilation/positive/test071.juvix +++ b/tests/Compilation/positive/test071.juvix @@ -20,24 +20,49 @@ mkOrdHelper (cmp : A -> A -> Ordering) {lt : A -> A -> Bool := λ {a b := isLT (cmp a b)}} {gt : A -> A -> Bool := λ {a b := isGT (cmp a b)}} - : Ord A := - mkOrd cmp lt gt; + : Ord A := mkOrd cmp lt gt; instance -ordNat : Ord Nat := mkOrdHelper@{ - cmp (x y : Nat) : Ordering := Ord.compare x y -}; +ordNat : Ord Nat := + mkOrdHelper@{ + cmp (x y : Nat) : Ordering := Ord.compare x y + }; -fun {a : Nat := 1} {b : Nat := a + 1} {c : Nat := b + a + 1} +fun + {a : Nat := 1} + {b : Nat := a + 1} + {c : Nat := b + a + 1} : Nat := a * b + c; -f {a : Nat := 2} {b : Nat := a + 1} {c : Nat} : Nat := a * b * c; +f {a : Nat := 2} {b : Nat := a + 1} {c : Nat} : Nat := + a * b * c; -g {a : Nat := 2} {b : Nat := a + 1} (c : Nat) : Nat := a * b * c; +g {a : Nat := 2} {b : Nat := a + 1} (c : Nat) : Nat := + a * b * c; -h {a : Nat := 2} (b c : Nat) {d : Nat := 3} : Nat := a * b + c * d; +h {a : Nat := 2} (b c : Nat) {d : Nat := 3} : Nat := + a * b + c * d; main : Nat := - fun@{a := fun; b := fun@{b := 3} * fun@{b := fun {2}}} + - f@{c := 5} + g@?{b := 4} 3 + ite (Ord.lt 1 0) 1 0 + - h@?{b := 4} 1; + fun@{ + a := fun; + b := + fun@{ + b := 3 + } + * fun@{ + b := fun {2} + } + } + + f@{ + c := 5 + } + + g@?{ + b := 4 + } + 3 + + ite (Ord.lt 1 0) 1 0 + + h@?{ + b := 4 + } + 1; diff --git a/tests/Compilation/positive/test072/ExceptT.juvix b/tests/Compilation/positive/test072/ExceptT.juvix index 3bf4c7e84f..d9eead84cb 100644 --- a/tests/Compilation/positive/test072/ExceptT.juvix +++ b/tests/Compilation/positive/test072/ExceptT.juvix @@ -88,5 +88,8 @@ ExceptT-MonadError mkExceptT (MMonad.return (left err)) }; -runExcept {Err A} {M : Type -> Type} : ExceptT Err M A -> M (Either Err A) - | (mkExceptT x) := x; +runExcept + {Err A} + {M : Type -> Type} + : ExceptT Err M A -> M (Either Err A) + | (mkExceptT x) := x; diff --git a/tests/Compilation/positive/test072/Functor.juvix b/tests/Compilation/positive/test072/Functor.juvix index ff69a11d61..ae7328f9da 100644 --- a/tests/Compilation/positive/test072/Functor.juvix +++ b/tests/Compilation/positive/test072/Functor.juvix @@ -9,5 +9,10 @@ type Functor (f : Type -> Type) := <$> : {A B : Type} -> (A -> B) -> f A -> f B }; -fmap {f : Type -> Type} {{Functor f}} {A B : Type} (fun : A -> B) (x : f A) : f B := - fun Functor.<$> x +fmap + {f : Type -> Type} + {{Functor f}} + {A B : Type} + (fun : A -> B) + (x : f A) + : f B := fun Functor.<$> x; diff --git a/tests/Compilation/positive/test072/Identity.juvix b/tests/Compilation/positive/test072/Identity.juvix index 1d84c8fad2..b5aaa756c3 100644 --- a/tests/Compilation/positive/test072/Identity.juvix +++ b/tests/Compilation/positive/test072/Identity.juvix @@ -19,7 +19,8 @@ Identity-Monad : Monad Identity := mkMonad@{ functor := Identity-Functor; return {A : Type} (a : A) : Identity A := mkIdentity a; - >>= {A B : Type} + >>= + {A B : Type} : Identity A -> (A -> Identity B) -> Identity B | (mkIdentity a) f := f a }; diff --git a/tests/Compilation/positive/test072/Monad.juvix b/tests/Compilation/positive/test072/Monad.juvix index 7128d8e3e5..95f6eb9f83 100644 --- a/tests/Compilation/positive/test072/Monad.juvix +++ b/tests/Compilation/positive/test072/Monad.juvix @@ -17,7 +17,13 @@ type Monad (f : Type -> Type) := open Monad public; syntax operator >>> bind; ->>> {M : Type → Type} {A B : Type} {{Monad M}} (x : M - A) (y : M B) : M B := x >>= λ {_ := y}; +>>> + {M : Type → Type} + {A B : Type} + {{Monad M}} + (x : M A) + (y : M B) + : M B := x >>= λ {_ := y}; -getFunctor {M : Type -> Type} (_ : Monad M) : Functor M := Monad.functor; +getFunctor {M : Type -> Type} (_ : Monad M) : Functor M := + Monad.functor; diff --git a/tests/Compilation/positive/test072/MonadError.juvix b/tests/Compilation/positive/test072/MonadError.juvix index 9f762c9152..8be72dc81e 100644 --- a/tests/Compilation/positive/test072/MonadError.juvix +++ b/tests/Compilation/positive/test072/MonadError.juvix @@ -7,7 +7,7 @@ trait type MonadError (Err : Type) (M : Type -> Type) := mkMonadError { monad : Monad M; - throw : {A : Type} -> Err -> M A; + throw : {A : Type} -> Err -> M A }; open MonadError public; diff --git a/tests/Compilation/positive/test072/MonadState.juvix b/tests/Compilation/positive/test072/MonadState.juvix index fc9eb31de0..9a8c446c35 100644 --- a/tests/Compilation/positive/test072/MonadState.juvix +++ b/tests/Compilation/positive/test072/MonadState.juvix @@ -13,6 +13,10 @@ type MonadState (S : Type) (M : Type -> Type) := open MonadState public; -modify {S : Type} {M : Type → Type} {{Monad M}} {{MonadState - S - M}} (f : S → S) : M Unit := get >>= λ {s := put (f s)}; +modify + {S : Type} + {M : Type → Type} + {{Monad M}} + {{MonadState S M}} + (f : S → S) + : M Unit := get >>= λ {s := put (f s)}; diff --git a/tests/Compilation/positive/test072/Package.juvix b/tests/Compilation/positive/test072/Package.juvix index d86c375987..16589dc288 100644 --- a/tests/Compilation/positive/test072/Package.juvix +++ b/tests/Compilation/positive/test072/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {name := "monads"}; +package : Package := + defaultPackage@?{ + name := "monads" + }; diff --git a/tests/Compilation/positive/test072/Reader.juvix b/tests/Compilation/positive/test072/Reader.juvix index 8de25df4a4..dd43a1e93a 100644 --- a/tests/Compilation/positive/test072/Reader.juvix +++ b/tests/Compilation/positive/test072/Reader.juvix @@ -19,7 +19,8 @@ Reader-Monad {R : Type} : Monad (Reader R) := functor := Reader-Functor; return {A : Type} (a : A) : Reader R A := mkReader (const a); - >>= {A B : Type} + >>= + {A B : Type} : Reader R A -> (A -> Reader R B) -> Reader R B | (mkReader ra) arb := let diff --git a/tests/Compilation/positive/test072/State.juvix b/tests/Compilation/positive/test072/State.juvix index 939ebbe48e..989877f3af 100644 --- a/tests/Compilation/positive/test072/State.juvix +++ b/tests/Compilation/positive/test072/State.juvix @@ -4,14 +4,15 @@ import Monad open; import Functor open; import Stdlib.Data.Pair open; -type State (S A : Type) := mkState {runState : S -> Pair A S}; +type State (S A : Type) := + mkState {runState : S -> Pair A S}; instance State-Functor {S : Type} : Functor (State S) := mkFunctor@{ <$> {A B : Type} (f : A -> B) : State S A -> State S B | (mkState S→A×S) := - mkState λ {s := case S→A×S s of {a, s := f a, s}} + mkState λ {s := case S→A×S s of a, s := f a, s} }; instance @@ -20,14 +21,13 @@ State-Monad {S : Type} : Monad (State S) := functor := State-Functor; return {A : Type} (a : A) : State S A := mkState λ {s := a, s}; - >>= {A B : Type} - : State S A -> (A -> State S B) -> State S B + >>= + {A B : Type} : State S A -> (A -> State S B) -> State S B | (mkState s→s×a) a→Ss×b := mkState λ {s := - case s→s×a s of { - a, s1 := case a→Ss×b a of {mkState s→s×b := s→s×b s1} - }} + case s→s×a s of + a, s1 := case a→Ss×b a of mkState s→s×b := s→s×b s1} }; import MonadState open; diff --git a/tests/Compilation/positive/test072/StateT.juvix b/tests/Compilation/positive/test072/StateT.juvix index 3ea027ccfd..8a61eb4f9b 100644 --- a/tests/Compilation/positive/test072/StateT.juvix +++ b/tests/Compilation/positive/test072/StateT.juvix @@ -9,18 +9,27 @@ import Stdlib.Data.Pair open; type StateT (S : Type) (M : Type → Type) (A : Type) := mkStateT {runStateT : S → M (Pair A S)}; -runState {S A : Type} {M : Type → Type} (s : S) (m : StateT - S - M - A) : M (Pair A S) := StateT.runStateT m s; +runState + {S A : Type} + {M : Type → Type} + (s : S) + (m : StateT S M A) + : M (Pair A S) := StateT.runStateT m s; -evalState {S A : Type} {M : Type → Type} {{Functor - M}} (s : S) (m : StateT S M A) : M A := - fst Functor.<$> runState s m; +evalState + {S A : Type} + {M : Type → Type} + {{Functor M}} + (s : S) + (m : StateT S M A) + : M A := fst Functor.<$> runState s m; instance -StateT-Functor {S : Type} {M : Type → Type} {{func : Functor - M}} : Functor (StateT S M) := +StateT-Functor + {S : Type} + {M : Type → Type} + {{func : Functor M}} + : Functor (StateT S M) := mkFunctor@{ <$> {A B : Type} (f : A → B) : StateT S M A → StateT S M B | (mkStateT S→M⟨A×S⟩) := @@ -31,7 +40,10 @@ StateT-Functor {S : Type} {M : Type → Type} {{func : Functor }; instance -StateT-Monad {S : Type} {M : Type → Type} {{mon : Monad M}} +StateT-Monad + {S : Type} + {M : Type → Type} + {{mon : Monad M}} : Monad (StateT S M) := mkMonad@{ functor := @@ -40,7 +52,10 @@ StateT-Monad {S : Type} {M : Type → Type} {{mon : Monad M}} }; return {A : Type} (a : A) : StateT S M A := mkStateT λ {s := MMonad.return (a, s)}; - >>= {A B : Type} (x : StateT S M A) (f : A → StateT S M B) + >>= + {A B : Type} + (x : StateT S M A) + (f : A → StateT S M B) : StateT S M B := mkStateT λ {s := @@ -52,7 +67,10 @@ import MonadState open; import Stdlib.Data.Unit open; instance -StateT-MonadState {S : Type} {M : Type → Type} {{Monad M}} +StateT-MonadState + {S : Type} + {M : Type → Type} + {{Monad M}} : MonadState S (StateT S M) := mkMonadState@{ monad := StateT-Monad; diff --git a/tests/Compilation/positive/test073/Package.juvix b/tests/Compilation/positive/test073/Package.juvix index 905b22a801..eec3c8b6d8 100644 --- a/tests/Compilation/positive/test073/Package.juvix +++ b/tests/Compilation/positive/test073/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {name := "test073"}; +package : Package := + defaultPackage@?{ + name := "test073" + }; diff --git a/tests/Internal/positive/Dependencies/Dep1/Conflict.juvix b/tests/Internal/positive/Dependencies/Dep1/Conflict.juvix index 5b3978f4e7..885fd0f2a0 100644 --- a/tests/Internal/positive/Dependencies/Dep1/Conflict.juvix +++ b/tests/Internal/positive/Dependencies/Dep1/Conflict.juvix @@ -1,3 +1 @@ module Conflict; - -end; diff --git a/tests/Internal/positive/Dependencies/Dep1/Dep1/Lib.juvix b/tests/Internal/positive/Dependencies/Dep1/Dep1/Lib.juvix index 600168b540..22120dcad6 100644 --- a/tests/Internal/positive/Dependencies/Dep1/Dep1/Lib.juvix +++ b/tests/Internal/positive/Dependencies/Dep1/Dep1/Lib.juvix @@ -1,3 +1 @@ module Dep1.Lib; - -end; diff --git a/tests/Internal/positive/Dependencies/Dep1/Package.juvix b/tests/Internal/positive/Dependencies/Dep1/Package.juvix index 19e86309e9..bd6138a7a3 100644 --- a/tests/Internal/positive/Dependencies/Dep1/Package.juvix +++ b/tests/Internal/positive/Dependencies/Dep1/Package.juvix @@ -3,4 +3,7 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage {name := "dep1"; dependencies := []}; + defaultPackage@?{ + name := "dep1"; + dependencies := [] + }; diff --git a/tests/Internal/positive/Dependencies/Dep2/Conflict.juvix b/tests/Internal/positive/Dependencies/Dep2/Conflict.juvix index 5b3978f4e7..885fd0f2a0 100644 --- a/tests/Internal/positive/Dependencies/Dep2/Conflict.juvix +++ b/tests/Internal/positive/Dependencies/Dep2/Conflict.juvix @@ -1,3 +1 @@ module Conflict; - -end; diff --git a/tests/Internal/positive/Dependencies/Dep2/Dep2/Lib.juvix b/tests/Internal/positive/Dependencies/Dep2/Dep2/Lib.juvix index 5f653706c8..3f0aafe2b5 100644 --- a/tests/Internal/positive/Dependencies/Dep2/Dep2/Lib.juvix +++ b/tests/Internal/positive/Dependencies/Dep2/Dep2/Lib.juvix @@ -1,3 +1 @@ module Dep2.Lib; - -end; diff --git a/tests/Internal/positive/Dependencies/Dep2/Package.juvix b/tests/Internal/positive/Dependencies/Dep2/Package.juvix index 29ba5ccab0..a32d05f4db 100644 --- a/tests/Internal/positive/Dependencies/Dep2/Package.juvix +++ b/tests/Internal/positive/Dependencies/Dep2/Package.juvix @@ -3,4 +3,7 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage {name := "dep2"; dependencies := []}; + defaultPackage@?{ + name := "dep2"; + dependencies := [] + }; diff --git a/tests/Rust/Compilation/positive/test067.juvix b/tests/Rust/Compilation/positive/test067.juvix index c9fb065f98..5c1b90d87d 100644 --- a/tests/Rust/Compilation/positive/test067.juvix +++ b/tests/Rust/Compilation/positive/test067.juvix @@ -5,4 +5,7 @@ import Stdlib.Data.Nat open; f {a : Nat := 2} {b : Nat := a + 1} {c : Nat} : Nat := a * b * c; -main : Nat := f {c := 5}; +main : Nat := + f@?{ + c := 5 + }; diff --git a/tests/Rust/Compilation/positive/test069.juvix b/tests/Rust/Compilation/positive/test069.juvix index e5ec4e3f72..ae81285b3c 100644 --- a/tests/Rust/Compilation/positive/test069.juvix +++ b/tests/Rust/Compilation/positive/test069.juvix @@ -20,10 +20,12 @@ mkOrdHelper (cmp : A -> A -> Ordering) {lt : A -> A -> Bool := λ {a b := isLT (cmp a b)}} {gt : A -> A -> Bool := λ {a b := isGT (cmp a b)}} - : Ord A := - mkOrd cmp lt gt; + : Ord A := mkOrd cmp lt gt; -ordNatNamed : Ord Nat := mkOrdHelper (cmp := Ord.compare); +ordNatNamed : Ord Nat := + mkOrdHelper@?{ + cmp := Ord.compare + }; instance ordNat : Ord Nat := mkOrdHelper Ord.compare; diff --git a/tests/Rust/Compilation/positive/test070.juvix b/tests/Rust/Compilation/positive/test070.juvix index 171cf12e8b..9a9b0f653e 100644 --- a/tests/Rust/Compilation/positive/test070.juvix +++ b/tests/Rust/Compilation/positive/test070.juvix @@ -3,8 +3,16 @@ module test070; import Stdlib.Data.Nat open; -fun {a : Nat := 1} {b : Nat := a + 1} {c : Nat := b + a + 1} - : Nat := a * b + c; +fun {a : Nat := 1} {b : Nat := a + 1} {c : Nat := b + a + 1} : Nat := a * b + c; main : Nat := - fun {a := fun; b := fun {b := 3} * fun {b := fun {2}}}; + fun@?{ + a := fun; + b := + fun@?{ + b := 3 + } + * fun@?{ + b := fun {2} + } + }; diff --git a/tests/Rust/Compilation/positive/test072/Package.juvix b/tests/Rust/Compilation/positive/test072/Package.juvix index d86c375987..16589dc288 100644 --- a/tests/Rust/Compilation/positive/test072/Package.juvix +++ b/tests/Rust/Compilation/positive/test072/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {name := "monads"}; +package : Package := + defaultPackage@?{ + name := "monads" + }; diff --git a/tests/Rust/Compilation/positive/test073/Package.juvix b/tests/Rust/Compilation/positive/test073/Package.juvix index 905b22a801..eec3c8b6d8 100644 --- a/tests/Rust/Compilation/positive/test073/Package.juvix +++ b/tests/Rust/Compilation/positive/test073/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {name := "test073"}; +package : Package := + defaultPackage@?{ + name := "test073" + }; diff --git a/tests/negative/DefaultArgCycle.juvix b/tests/negative/DefaultArgCycle.juvix deleted file mode 100644 index 8cec864ca3..0000000000 --- a/tests/negative/DefaultArgCycle.juvix +++ /dev/null @@ -1,7 +0,0 @@ -module DefaultArgCycle; - -import Stdlib.Data.Nat open; - -fun {a : Nat := 1} {b : Nat := fun {c := 3} - + a - + 1} {c : Nat := b + a + 1} : Nat := a * b + c; diff --git a/tests/negative/DuplicateArgument.juvix b/tests/negative/DuplicateArgument.juvix index 8426ef31b0..362ce08e77 100644 --- a/tests/negative/DuplicateArgument.juvix +++ b/tests/negative/DuplicateArgument.juvix @@ -4,4 +4,8 @@ type T := t : T; f (a : T) : T := t; -x : T := f (a := t; a := t); +x : T := + f@?{ + a := t; + a := t + }; diff --git a/tests/negative/Internal/AmbiguousCoercions.juvix b/tests/negative/Internal/AmbiguousCoercions.juvix index d76e38255f..22c534a0b7 100644 --- a/tests/negative/Internal/AmbiguousCoercions.juvix +++ b/tests/negative/Internal/AmbiguousCoercions.juvix @@ -12,10 +12,16 @@ trait type T2 A := mkT2 {pp : A → A}; instance -unitT1 : T1 Unit := mkT1 (pp := λ {_ := unit}); +unitT1 : T1 Unit := + mkT1@{ + pp := λ {_ := unit} + }; instance -unitT2 : T2 Unit := mkT2 (pp := λ {_ := unit}); +unitT2 : T2 Unit := + mkT2@{ + pp := λ {_ := unit} + }; coercion instance fromT1toT {A} {{T1 A}} : T A := diff --git a/tests/negative/Internal/AmbiguousInstances.juvix b/tests/negative/Internal/AmbiguousInstances.juvix index ca383fc94b..8d5aae58c4 100644 --- a/tests/negative/Internal/AmbiguousInstances.juvix +++ b/tests/negative/Internal/AmbiguousInstances.juvix @@ -8,15 +8,24 @@ trait type T A := mkT {pp : A → A}; instance -unitT : T Unit := mkT (pp := λ {_ := unit}); +unitT : T Unit := + mkT@{ + pp := λ {_ := unit} + }; ppBox {A B} {{T A}} : Box A B → Box A B | (box x y) := box (T.pp x) y; instance -boxT {A} {{T A}} : T (Box A Unit) := mkT (pp := ppBox); +boxT {A} {{T A}} : T (Box A Unit) := + mkT@{ + pp := ppBox + }; instance -boxTUnit {B} : T (Box Unit B) := mkT (pp := λ {x := x}); +boxTUnit {B} : T (Box Unit B) := + mkT@{ + pp := λ {x := x} + }; main : Box Unit Unit := T.pp (box unit unit); diff --git a/tests/negative/Internal/ExplicitInstanceArgument.juvix b/tests/negative/Internal/ExplicitInstanceArgument.juvix index 7e46c839d8..59aefdd7d2 100644 --- a/tests/negative/Internal/ExplicitInstanceArgument.juvix +++ b/tests/negative/Internal/ExplicitInstanceArgument.juvix @@ -8,9 +8,15 @@ trait type T A := mkT {pp : A → A}; instance -unitT : T Unit := mkT (pp := λ {_ := unit}); +unitT : T Unit := + mkT@{ + pp := λ {_ := unit} + }; instance -boxT {A} (x : Box A) : T (Box A) := mkT (pp := \ {_ := x}); +boxT {A} (x : Box A) : T (Box A) := + mkT@{ + pp := \ {_ := x} + }; main : Box Unit := T.pp (box unit); diff --git a/tests/negative/Internal/SubsumedInstance.juvix b/tests/negative/Internal/SubsumedInstance.juvix index 23f7999af7..8b397ddc83 100644 --- a/tests/negative/Internal/SubsumedInstance.juvix +++ b/tests/negative/Internal/SubsumedInstance.juvix @@ -8,15 +8,24 @@ trait type T A := mkT {pp : A → A}; instance -unitT : T Unit := mkT (pp := λ {_ := unit}); +unitT : T Unit := + mkT@{ + pp := λ {_ := unit} + }; ppBox {A} {{T A}} : Box A → Box A | (box x) := box (T.pp x); instance -boxT {A} {{T A}} : T (Box A) := mkT (pp := ppBox); +boxT {A} {{T A}} : T (Box A) := + mkT@{ + pp := ppBox + }; instance -boxTUnit : T (Box Unit) := mkT (pp := λ {x := x}); +boxTUnit : T (Box Unit) := + mkT@{ + pp := λ {x := x} + }; main : Box Unit := T.pp (box unit); diff --git a/tests/negative/MissingArgument.juvix b/tests/negative/MissingArgument.juvix index 3e6d7a28f3..b31fe67e18 100644 --- a/tests/negative/MissingArgument.juvix +++ b/tests/negative/MissingArgument.juvix @@ -4,4 +4,7 @@ type T := t : T; f (a : T) (b : T) : T := t; -x : T := f (b := t); +x : T := + f@?{ + b := t + }; diff --git a/tests/negative/NoDependencies/Package.juvix b/tests/negative/NoDependencies/Package.juvix index 78e56f4d7a..a6223b86a4 100644 --- a/tests/negative/NoDependencies/Package.juvix +++ b/tests/negative/NoDependencies/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {dependencies := []}; +package : Package := + defaultPackage@?{ + dependencies := [] + }; diff --git a/tests/negative/NoNamedArguments.juvix b/tests/negative/NoNamedArguments.juvix index 7ba02fbfbc..367e11e4a3 100644 --- a/tests/negative/NoNamedArguments.juvix +++ b/tests/negative/NoNamedArguments.juvix @@ -2,4 +2,6 @@ module NoNamedArguments; axiom T : Type; -axiom B : T (x := Type); +axiom B : T@?{ + x := Type +}; diff --git a/tests/negative/Package/PackageJuvixDuplicateDependencies/Package.juvix b/tests/negative/Package/PackageJuvixDuplicateDependencies/Package.juvix index 47c70f0213..8005e06fd7 100644 --- a/tests/negative/Package/PackageJuvixDuplicateDependencies/Package.juvix +++ b/tests/negative/Package/PackageJuvixDuplicateDependencies/Package.juvix @@ -2,6 +2,6 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {name := "abc"; version := mkVersion 0 0 1 ; dependencies := [ github "org" "repo" "ref1" ; github "org" "repo" "ref2" ]}; +package : Package := defaultPackage@?{name := "abc"; version := mkVersion 0 0 1 ; dependencies := [ github "org" "repo" "ref1" ; github "org" "repo" "ref2" ]}; main : Package := package; diff --git a/tests/negative/UnexpectedArgument.juvix b/tests/negative/UnexpectedArgument.juvix index 48444eff7d..4bc72c7ef4 100644 --- a/tests/negative/UnexpectedArgument.juvix +++ b/tests/negative/UnexpectedArgument.juvix @@ -4,4 +4,7 @@ type T := t : T; f (a : T) : T := t; -x : T := f (x := t); +x : T := + f@?{ + x := t + }; diff --git a/tests/negative/UnexpectedArgumentWildcard.juvix b/tests/negative/UnexpectedArgumentWildcard.juvix index e86cdaf3e7..52921d51d1 100644 --- a/tests/negative/UnexpectedArgumentWildcard.juvix +++ b/tests/negative/UnexpectedArgumentWildcard.juvix @@ -5,4 +5,8 @@ type T := t : T; f (a : T) : {_ : Type} -> (b : T) -> T | b := t; -x : T := f (a := t) (b := t); +x : T := + f@?{ + a := t; + b := t + }; diff --git a/tests/negative/issue2771/Package.juvix b/tests/negative/issue2771/Package.juvix index 5ff26d7b68..a92a023e82 100644 --- a/tests/negative/issue2771/Package.juvix +++ b/tests/negative/issue2771/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {name := "issue2771"}; +package : Package := + defaultPackage@?{ + name := "issue2771" + }; diff --git a/tests/positive/Dependencies/.libs/Extra/Package.juvix b/tests/positive/Dependencies/.libs/Extra/Package.juvix index 1a80108152..054e8f38da 100644 --- a/tests/positive/Dependencies/.libs/Extra/Package.juvix +++ b/tests/positive/Dependencies/.libs/Extra/Package.juvix @@ -3,9 +3,8 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage - {name := "extra"; - version := mkVersion 1 0 0; - dependencies := [ path ".juvix-build/stdlib" - ; path "../Base" - ]}; + defaultPackage@?{ + name := "extra"; + version := mkVersion 1 0 0; + dependencies := [path ".juvix-build/stdlib"; path "../Base"] + }; diff --git a/tests/positive/Dependencies/Package.juvix b/tests/positive/Dependencies/Package.juvix index f6393664f5..338e18b9d8 100644 --- a/tests/positive/Dependencies/Package.juvix +++ b/tests/positive/Dependencies/Package.juvix @@ -3,10 +3,9 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage - {name := "main-project"; - version := mkVersion 0 0 1; - dependencies := [ path ".libs/Extra" - ; path ".libs/Base" - ; defaultStdlib - ]}; + defaultPackage@?{ + name := "main-project"; + version := mkVersion 0 0 1; + dependencies := + [path ".libs/Extra"; path ".libs/Base"; defaultStdlib] + }; diff --git a/tests/positive/FancyPaths/Package.juvix b/tests/positive/FancyPaths/Package.juvix index dd29d3ad5f..8cac8ffad8 100644 --- a/tests/positive/FancyPaths/Package.juvix +++ b/tests/positive/FancyPaths/Package.juvix @@ -3,8 +3,10 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage - {dependencies := [ path "../FancyPaths/././path with spaces" - ; path "$(JUVIX_TEST_PATH)/../$(JUVIX_TEST_PATH)/" - ; path "~" - ]}; + defaultPackage@?{ + dependencies := + [ path "../FancyPaths/././path with spaces" + ; path "$(JUVIX_TEST_PATH)/../$(JUVIX_TEST_PATH)/" + ; path "~" + ] + }; diff --git a/tests/positive/FancyPaths/home/Package.juvix b/tests/positive/FancyPaths/home/Package.juvix index 78e56f4d7a..a6223b86a4 100644 --- a/tests/positive/FancyPaths/home/Package.juvix +++ b/tests/positive/FancyPaths/home/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {dependencies := []}; +package : Package := + defaultPackage@?{ + dependencies := [] + }; diff --git a/tests/positive/FancyPaths/other dep/Package.juvix b/tests/positive/FancyPaths/other dep/Package.juvix index 78e56f4d7a..a6223b86a4 100644 --- a/tests/positive/FancyPaths/other dep/Package.juvix +++ b/tests/positive/FancyPaths/other dep/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {dependencies := []}; +package : Package := + defaultPackage@?{ + dependencies := [] + }; diff --git a/tests/positive/FancyPaths/path with spaces/Package.juvix b/tests/positive/FancyPaths/path with spaces/Package.juvix index 78e56f4d7a..a6223b86a4 100644 --- a/tests/positive/FancyPaths/path with spaces/Package.juvix +++ b/tests/positive/FancyPaths/path with spaces/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {dependencies := []}; +package : Package := + defaultPackage@?{ + dependencies := [] + }; diff --git a/tests/positive/Format.juvix b/tests/positive/Format.juvix index 57567ec4ce..6e08aa7b9f 100644 --- a/tests/positive/Format.juvix +++ b/tests/positive/Format.juvix @@ -297,13 +297,22 @@ module Traits; type Show A := mkShow {show : A → String}; instance - showStringI : Show String := mkShow (show := id); + showStringI : Show String := + mkShow@{ + show := id + }; instance - showBoolI : Show Bool := mkShow (show := λ {x := ite x "true" "false"}); + showBoolI : Show Bool := + mkShow@{ + show := λ {x := ite x "true" "false"} + }; instance - showNatI : Show Nat := mkShow (show := natToString); + showNatI : Show Nat := + mkShow@{ + show := natToString + }; showList {A} : {{Show A}} → List A → String | nil := "nil" @@ -312,14 +321,20 @@ module Traits; g : {A : Type} → {{Show A}} → Nat := 5; instance - showListI {A} {{Show A}} : Show (List A) := mkShow (show := showList); + showListI {A} {{Show A}} : Show (List A) := + mkShow@{ + show := showList + }; showMaybe {A} {{Show A}} : Maybe A → String | (just x) := "just (" ++str Show.show x ++str ")" | nothing := "nothing"; instance - showMaybeI {A} {{Show A}} : Show (Maybe A) := mkShow (show := showMaybe); + showMaybeI {A} {{Show A}} : Show (Maybe A) := + mkShow@{ + show := showMaybe + }; f {A} {{Show A}} : A → String | x := Show.show x; diff --git a/tests/positive/ImportNestedLocalModule/Package.juvix b/tests/positive/ImportNestedLocalModule/Package.juvix index d43d8425c9..59641083b1 100644 --- a/tests/positive/ImportNestedLocalModule/Package.juvix +++ b/tests/positive/ImportNestedLocalModule/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {name := "test074"}; +package : Package := + defaultPackage@?{ + name := "test074" + }; diff --git a/tests/positive/Literals.juvix b/tests/positive/Literals.juvix index 11af0aef53..2727e6710d 100644 --- a/tests/positive/Literals.juvix +++ b/tests/positive/Literals.juvix @@ -1,17 +1,13 @@ module Literals; -axiom Int : Type; - -axiom String : Type; - -axiom + : Int → Int → Int; +import Stdlib.Prelude open; a : Int := 12313; b : Int := -8; -- : Int := 10; +c : Int := 10; --+-- : Int := - + -+--; +-+-- : Int := c + c; -c : String := "hellooooo"; +d : String := "hellooooo"; diff --git a/tests/positive/MarkdownImport/Package.juvix b/tests/positive/MarkdownImport/Package.juvix index 14904cac12..b1daecbbdc 100644 --- a/tests/positive/MarkdownImport/Package.juvix +++ b/tests/positive/MarkdownImport/Package.juvix @@ -3,4 +3,6 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage {name := "MarkdownImport"}; + defaultPackage@?{ + name := "MarkdownImport" + }; diff --git a/tests/positive/MultiParams.juvix b/tests/positive/MultiParams.juvix index 0ce7579f76..6b7e829f74 100644 --- a/tests/positive/MultiParams.juvix +++ b/tests/positive/MultiParams.juvix @@ -2,8 +2,10 @@ module MultiParams; type Multi (A B C : Type) := mult : Multi A B C; -f : {A B : Type} → (C : Type) → {D E F : Type} → Type → Type - | C _ := C; +type T := t; -g : {A B : Type} → (C : Type) → {D _ F : Type} → Type → Type - | C _ := C; +f : {A B : Type} → (C : Type) → {D E F : Type} → Type → T + | C _ := t; + +g : {A B : Type} → (C : Type) → {D _ F : Type} → Type → T + | C _ := t; diff --git a/tests/positive/NamedArguments.juvix b/tests/positive/NamedArguments.juvix index 98c8094ca8..2365591bca 100644 --- a/tests/positive/NamedArguments.juvix +++ b/tests/positive/NamedArguments.juvix @@ -1,30 +1,39 @@ module NamedArguments; -axiom a : Type; +axiom A : Type; -axiom b : Type; +axiom B : Type; -axiom c : Type; +axiom C : Type; -axiom d : Type; +axiom D : Type; -axiom e : Type; +axiom E : Type; -axiom f : Type; +axiom F : Type; -axiom g : Type; +axiom G : Type; -axiom h : Type; +axiom H : Type; type Unit := unit : Unit; axiom fun1 : (a : Type) -> (b : Type) -> {c : Type} -> Type; -- all provided by name -t1 : Type := fun1 (a := a) (b := b) {c := c}; +t1 : Type := + fun1@?{ + a := A; + b := B; + c := C + }; -- skip implicit at the end -t1' : {_ : Type} -> Type := fun1 (b := b) (a := a); +t1' : {_ : Type} -> Type := + fun1@?{ + b := B; + a := A + }; axiom fun2 : (a : Type) -> (b : Type) @@ -33,7 +42,12 @@ axiom fun2 : (a : Type) -> Type; -- skip implicit in implicit group -t2 : {_ : Type} -> Type := fun2 (a := a) (b := b) {c := d}; +t2 : {_ : Type} -> Type := + fun2@?{ + a := A; + b := B; + c := D + }; axiom fun3 : (a : Type) -> (b : Type) @@ -42,7 +56,12 @@ axiom fun3 : (a : Type) -> Type; -- skip implicit in the middle -t3 : Type := fun3 (a := a) (b := b) {d := unit}; +t3 : Type := + fun3@?{ + a := A; + b := B; + d := unit + }; axiom fun4 : (a : Type) -> (b : Type) @@ -51,7 +70,12 @@ axiom fun4 : (a : Type) -> Type; -- skip implicit in the middle -t4 : Type := fun4 (a := a) (b := b) (d := unit); +t4 : Type := + fun4@?{ + a := A; + b := B; + d := unit + }; axiom fun5 : (a : Type) -> (b : Type) @@ -61,10 +85,20 @@ axiom fun5 : (a : Type) -> Type; t5 : Type := - fun5 (a := a) (b := b) (d' := unit) (d := unit); + fun5@?{ + a := A; + b := B; + d' := unit; + d := unit + }; t5' : Type := - fun5 (a := a; b := b) (d' := unit) (d := unit); + fun5@?{ + a := A; + b := B; + d' := unit; + d := unit + }; axiom fun6 : {a : Type} -> (b : Type) @@ -75,18 +109,38 @@ axiom fun6 : {a : Type} -> Type; t6 : Type := - fun6 (b := b) (d' := unit) (d := unit) (a' := unit); + fun6@?{ + b := B; + d' := unit; + d := unit; + a' := unit + }; t6' : Type := - fun6 (d' := unit; d := unit; a' := unit; b := b); + fun6@?{ + d' := unit; + d := unit; + a' := unit; + b := B + }; module FakeRecord; type Pair (A B : Type) := mkPair : (fst : A) -> (snd : B) -> Pair A B; - pp : Pair (B := Unit; A := Type) := - mkPair (snd := unit; fst := Type); - - pp2 : Pair (B := Unit; A := Type) := - mkPair (fst := Type) (unit); + pp + : Pair@?{ + B := Unit; + A := Type + } := + mkPair@?{ + snd := unit; + fst := Type + }; + + pp2 + : Pair@?{ + B := Unit; + A := Type + } := mkPair@?{fst := Type} (unit); end; diff --git a/tests/positive/NoDependencies/Package.juvix b/tests/positive/NoDependencies/Package.juvix index 78e56f4d7a..a6223b86a4 100644 --- a/tests/positive/NoDependencies/Package.juvix +++ b/tests/positive/NoDependencies/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {dependencies := []}; +package : Package := + defaultPackage@?{ + dependencies := [] + }; diff --git a/tests/positive/PackageLoader/PackageJuvix/Package.juvix b/tests/positive/PackageLoader/PackageJuvix/Package.juvix index 1c957125ec..4560e71afe 100644 --- a/tests/positive/PackageLoader/PackageJuvix/Package.juvix +++ b/tests/positive/PackageLoader/PackageJuvix/Package.juvix @@ -3,4 +3,6 @@ module Package; import PackageDescription.V1 open; package : Package := - defaultPackage {name := "package-juvix"}; + defaultPackage@?{ + name := "package-juvix" + }; diff --git a/tests/positive/PackageLoader/PackageJuvixAndYaml/Package.juvix b/tests/positive/PackageLoader/PackageJuvixAndYaml/Package.juvix index 1c957125ec..4560e71afe 100644 --- a/tests/positive/PackageLoader/PackageJuvixAndYaml/Package.juvix +++ b/tests/positive/PackageLoader/PackageJuvixAndYaml/Package.juvix @@ -3,4 +3,6 @@ module Package; import PackageDescription.V1 open; package : Package := - defaultPackage {name := "package-juvix"}; + defaultPackage@?{ + name := "package-juvix" + }; diff --git a/tests/positive/PackageLoader/PackageJuvixEmptyDependencies/Package.juvix b/tests/positive/PackageLoader/PackageJuvixEmptyDependencies/Package.juvix index 075e67f1bb..cfc67ae272 100644 --- a/tests/positive/PackageLoader/PackageJuvixEmptyDependencies/Package.juvix +++ b/tests/positive/PackageLoader/PackageJuvixEmptyDependencies/Package.juvix @@ -4,5 +4,7 @@ import Stdlib.Prelude open; import PackageDescription.V1 open; package : Package := - defaultPackage - {name := "package-juvix"; dependencies := []}; + defaultPackage@?{ + name := "package-juvix"; + dependencies := [] + }; diff --git a/tests/positive/PackageLoader/PackageJuvixUsesLockfile/Package.juvix b/tests/positive/PackageLoader/PackageJuvixUsesLockfile/Package.juvix index 52746ee05d..52fd1ea559 100644 --- a/tests/positive/PackageLoader/PackageJuvixUsesLockfile/Package.juvix +++ b/tests/positive/PackageLoader/PackageJuvixUsesLockfile/Package.juvix @@ -4,7 +4,8 @@ import Stdlib.Prelude open; import PackageDescription.V1 open; package : Package := - defaultPackage - {name := "abc"; - version := mkVersion 0 0 0; - dependencies := [git "name" "url" "ref1"]}; + defaultPackage@?{ + name := "abc"; + version := mkVersion 0 0 0; + dependencies := [git "name" "url" "ref1"] + }; diff --git a/tests/positive/PackageLoader/YamlEmptyDependencies/Package.juvix b/tests/positive/PackageLoader/YamlEmptyDependencies/Package.juvix index d1857b463d..8991581597 100644 --- a/tests/positive/PackageLoader/YamlEmptyDependencies/Package.juvix +++ b/tests/positive/PackageLoader/YamlEmptyDependencies/Package.juvix @@ -3,4 +3,7 @@ module Package; import PackageDescription.V1 open; package : Package := - defaultPackage {name := "abc"; dependencies := []}; + defaultPackage@?{ + name := "abc"; + dependencies := [] + }; diff --git a/tests/positive/PackageLoaderV2/PackageJuvix/Package.juvix b/tests/positive/PackageLoaderV2/PackageJuvix/Package.juvix index 475702edfb..efff5ba9b1 100644 --- a/tests/positive/PackageLoaderV2/PackageJuvix/Package.juvix +++ b/tests/positive/PackageLoaderV2/PackageJuvix/Package.juvix @@ -3,4 +3,6 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage {name := "package-juvix"}; + defaultPackage@?{ + name := "package-juvix" + }; diff --git a/tests/positive/PackageLoaderV2/PackageJuvixAndYaml/Package.juvix b/tests/positive/PackageLoaderV2/PackageJuvixAndYaml/Package.juvix index 475702edfb..efff5ba9b1 100644 --- a/tests/positive/PackageLoaderV2/PackageJuvixAndYaml/Package.juvix +++ b/tests/positive/PackageLoaderV2/PackageJuvixAndYaml/Package.juvix @@ -3,4 +3,6 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage {name := "package-juvix"}; + defaultPackage@?{ + name := "package-juvix" + }; diff --git a/tests/positive/PackageLoaderV2/PackageJuvixEmptyDependencies/Package.juvix b/tests/positive/PackageLoaderV2/PackageJuvixEmptyDependencies/Package.juvix index 90aa3d357c..61853bf96b 100644 --- a/tests/positive/PackageLoaderV2/PackageJuvixEmptyDependencies/Package.juvix +++ b/tests/positive/PackageLoaderV2/PackageJuvixEmptyDependencies/Package.juvix @@ -3,5 +3,7 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage - {name := "package-juvix"; dependencies := []}; + defaultPackage@?{ + name := "package-juvix"; + dependencies := [] + }; diff --git a/tests/positive/PackageLoaderV2/PackageJuvixUsesLockfile/Package.juvix b/tests/positive/PackageLoaderV2/PackageJuvixUsesLockfile/Package.juvix index 4e55ec8574..9e53af38cb 100644 --- a/tests/positive/PackageLoaderV2/PackageJuvixUsesLockfile/Package.juvix +++ b/tests/positive/PackageLoaderV2/PackageJuvixUsesLockfile/Package.juvix @@ -3,7 +3,8 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage - {name := "abc"; - version := mkVersion 0 0 0; - dependencies := [git "name" "url" "ref1"]}; + defaultPackage@?{ + name := "abc"; + version := mkVersion 0 0 0; + dependencies := [git "name" "url" "ref1"] + }; diff --git a/tests/positive/Projections.juvix b/tests/positive/Projections.juvix index c213054fa6..87f1ac097f 100644 --- a/tests/positive/Projections.juvix +++ b/tests/positive/Projections.juvix @@ -20,11 +20,19 @@ module M; }; p1 : RecA T (Maybe T) := - mkRecA - (arg := just - (mkRecB - (arg := mkRecA (arg := nothing; arg2 := t); arg2 := t)); - arg2 := t); + mkRecA@{ + arg := + just + mkRecB@{ + arg := + mkRecA@{ + arg := nothing; + arg2 := t + }; + arg2 := t + }; + arg2 := t + }; end; p3 : T := M.RecA.arg2 M.p1; diff --git a/tests/positive/Records.juvix b/tests/positive/Records.juvix index c7e12320c0..85be188405 100644 --- a/tests/positive/Records.juvix +++ b/tests/positive/Records.juvix @@ -12,7 +12,10 @@ type Pair (A B : Type) := }; p1 : Pair T T := - mkPair (fst := constructT; snd := constructT); + mkPair@{ + fst := constructT; + snd := constructT + }; type EnumRecord := | --- doc for C1 @@ -26,9 +29,18 @@ type EnumRecord := }; p2 : Pair EnumRecord EnumRecord := - mkPair - (fst := C1 (c1a := constructT; c1b := constructT); - snd := C2 (c2a := constructT; c2b := constructT)); + mkPair@{ + fst := + C1@?{ + c1a := constructT; + c1b := constructT + }; + snd := + C2@{ + c2a := constructT; + c2b := constructT + } + }; type newtype := mknewtype {f : T}; @@ -43,6 +55,5 @@ type Bool := | true; module Update; - f {A B : Type} (p : Pair A B) : Pair Bool B := - p@Pair{fst := true}; + f {A B : Type} (p : Pair A B) : Pair Bool B := p@Pair{fst := true}; end; diff --git a/tests/positive/StdlibList/Package.juvix b/tests/positive/StdlibList/Package.juvix index 78e56f4d7a..a6223b86a4 100644 --- a/tests/positive/StdlibList/Package.juvix +++ b/tests/positive/StdlibList/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {dependencies := []}; +package : Package := + defaultPackage@?{ + dependencies := [] + }; diff --git a/tests/positive/Traits.juvix b/tests/positive/Traits.juvix index 486e280115..91163ee3c8 100644 --- a/tests/positive/Traits.juvix +++ b/tests/positive/Traits.juvix @@ -11,4 +11,7 @@ ppBox {A} {{T A}} : Box A → Box A | (box x) := box (T.pp x); instance -boxT {A} {{T A}} : T (Box A) := mkT (pp := ppBox); +boxT {A} {{T A}} : T (Box A) := + mkT@{ + pp := ppBox + }; diff --git a/tests/positive/VisibilityPrecendence/Package.juvix b/tests/positive/VisibilityPrecendence/Package.juvix index 23697de31d..0027a3bac2 100644 --- a/tests/positive/VisibilityPrecendence/Package.juvix +++ b/tests/positive/VisibilityPrecendence/Package.juvix @@ -2,4 +2,7 @@ module Package; import PackageDescription.V2 open; -package : Package := defaultPackage {name := "test075"}; +package : Package := + defaultPackage@?{ + name := "test075" + }; diff --git a/tests/positive/package/Package.juvix b/tests/positive/package/Package.juvix index 796cb1b335..3fdd19ead7 100644 --- a/tests/positive/package/Package.juvix +++ b/tests/positive/package/Package.juvix @@ -3,9 +3,11 @@ module Package; import PackageDescription.V2 open; package : Package := - defaultPackage - {name := "foo"; - version := mkVersion 0 1 0; - dependencies := [ github "anoma" "juvix-stdlib" "adf58a7180b361a022fb53c22ad9e5274ebf6f66" - ; github "anoma" "juvix-containers" "v0.7.1" - ]}; + defaultPackage@?{ + name := "foo"; + version := mkVersion 0 1 0; + dependencies := + [ github "anoma" "juvix-stdlib" "adf58a7180b361a022fb53c22ad9e5274ebf6f66" + ; github "anoma" "juvix-containers" "v0.7.1" + ] + };