diff --git a/src/Juvix/Compiler/Core/Data/Module.hs b/src/Juvix/Compiler/Core/Data/Module.hs index 4a7502f92a..6c3baee651 100644 --- a/src/Juvix/Compiler/Core/Data/Module.hs +++ b/src/Juvix/Compiler/Core/Data/Module.hs @@ -15,6 +15,9 @@ data Module = Module -- B will be in the imports table of M nonetheless. _moduleImportsTable :: InfoTable } + deriving stock (Generic) + +instance NFData Module makeLenses ''Module diff --git a/src/Juvix/Compiler/Core/Info.hs b/src/Juvix/Compiler/Core/Info.hs index 8d615f7df6..844f818449 100644 --- a/src/Juvix/Compiler/Core/Info.hs +++ b/src/Juvix/Compiler/Core/Info.hs @@ -13,6 +13,12 @@ newtype Info = Info } deriving newtype (Semigroup, Monoid) +-- | NOTE the NFData instance for Info is a noop. I don't think it's possible to +-- provide an NFData instance for it because a Dynamic can't have an instance. +-- Still, having this instance is useful so we can derive NFData for Node. +instance NFData Info where + rnf _info = () + type Key = Proxy makeLenses ''Info diff --git a/src/Juvix/Compiler/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs index 7542c90734..f45de78968 100644 --- a/src/Juvix/Compiler/Core/Language.hs +++ b/src/Juvix/Compiler/Core/Language.hs @@ -94,7 +94,9 @@ data Node { _closureEnv :: !Env, _closureNode :: !Node } - deriving stock (Eq) + deriving stock (Eq, Generic) + +instance NFData Node -- Other things we might need in the future: -- - laziness annotations (converting these to closure/thunk creation should be diff --git a/src/Juvix/Compiler/Core/Language/Nodes.hs b/src/Juvix/Compiler/Core/Language/Nodes.hs index 68cb9ce6dd..3c8bd8c803 100644 --- a/src/Juvix/Compiler/Core/Language/Nodes.hs +++ b/src/Juvix/Compiler/Core/Language/Nodes.hs @@ -171,6 +171,7 @@ data Match' i a = Match _matchValues :: !(NonEmpty a), _matchBranches :: ![MatchBranch' i a] } + deriving stock (Generic) -- | The patterns introduce binders from left to right, with the binder for a -- constructor before the binders for the subpatterns, e.g., matching on the @@ -185,15 +186,18 @@ data MatchBranch' i a = MatchBranch _matchBranchPatterns :: !(NonEmpty (Pattern' i a)), _matchBranchRhs :: !(MatchBranchRhs' i a) } + deriving stock (Generic) data Pattern' i a = PatWildcard (PatternWildcard' i a) | PatConstr (PatternConstr' i a) + deriving stock (Generic) data PatternWildcard' i a = PatternWildcard { _patternWildcardInfo :: i, _patternWildcardBinder :: Binder' a } + deriving stock (Generic) data PatternConstr' i a = PatternConstr { _patternConstrInfo :: i, @@ -202,22 +206,26 @@ data PatternConstr' i a = PatternConstr _patternConstrTag :: !Tag, _patternConstrArgs :: ![Pattern' i a] } + deriving stock (Generic) data MatchBranchRhs' i a = MatchBranchRhsExpression !a | MatchBranchRhsIfs !(NonEmpty (SideIfBranch' i a)) + deriving stock (Generic) data SideIfBranch' i a = SideIfBranch { _sideIfBranchInfo :: i, _sideIfBranchCondition :: !a, _sideIfBranchBody :: !a } + deriving stock (Generic) -- | Useful for unfolding Pi data PiLhs' i a = PiLhs { _piLhsInfo :: i, _piLhsBinder :: Binder' a } + deriving stock (Generic) -- | Dependent Pi-type. Compilation-time only. Pi implicitly introduces a binder -- in the body, exactly like Lambda. So `Pi info ty body` is `Pi x : ty . @@ -335,6 +343,20 @@ instance (Serialize i) => Serialize (Univ' i) instance (NFData i) => NFData (Univ' i) +instance (NFData i, NFData a) => NFData (PatternWildcard' i a) + +instance (NFData i, NFData a) => NFData (PatternConstr' i a) + +instance (NFData i, NFData a) => NFData (Pattern' i a) + +instance (NFData i, NFData a) => NFData (MatchBranchRhs' i a) + +instance (NFData i, NFData a) => NFData (SideIfBranch' i a) + +instance (NFData i, NFData a) => NFData (MatchBranch' i a) + +instance (NFData i, NFData a) => NFData (Match' i a) + instance (Serialize i) => Serialize (TypePrim' i) instance (NFData i) => NFData (TypePrim' i)