Use NSet for both recursive and non-recursive sets

Simplifies the AST

Author: infinisil

src/Nix/Eval.hs

@@ -141,11 +141,11 @@ eval (NList l           ) = do
   scope <- currentScopes
   for l (defer @v @m . withScopes @v scope) >>= toValue
 
-eval (NSet binds) =
-  evalBinds False (desugarBinds (eval . NSet) binds) >>= toValue
+eval (NSet NNonRecursive binds) =
+  evalBinds False (desugarBinds (eval . NSet NNonRecursive) binds) >>= toValue
 
-eval (NRecSet binds) =
-  evalBinds True (desugarBinds (eval . NSet) binds) >>= toValue
+eval (NSet NRecursive binds) =
+  evalBinds True (desugarBinds (eval . NSet NNonRecursive) binds) >>= toValue
 
 eval (NLet binds body    ) = evalBinds True binds >>= (pushScope ?? body) . fst
 

src/Nix/Expr/Shorthands.hs

@@ -18,6 +18,7 @@ import           Text.Megaparsec.Pos            ( SourcePos )
 mkInt :: Integer -> NExpr
 mkInt = Fix . mkIntF
 
+
 mkIntF :: Integer -> NExprF a
 mkIntF = NConstant . NInt
 
@@ -101,10 +102,10 @@ mkParamset :: [(Text, Maybe NExpr)] -> Bool -> Params NExpr
 mkParamset params variadic = ParamSet params variadic Nothing
 
 mkRecSet :: [Binding NExpr] -> NExpr
-mkRecSet = Fix . NRecSet
+mkRecSet = Fix . NSet NRecursive
 
 mkNonRecSet :: [Binding NExpr] -> NExpr
-mkNonRecSet = Fix . NSet
+mkNonRecSet = Fix . NSet NNonRecursive
 
 mkLets :: [Binding NExpr] -> NExpr -> NExpr
 mkLets bindings = Fix . NLet bindings
@@ -161,10 +162,9 @@ infixr 2 $=
 -- `let a = 1; b = 2; c = 3; in 4`.
 appendBindings :: [Binding NExpr] -> NExpr -> NExpr
 appendBindings newBindings (Fix e) = case e of
-  NLet bindings e' -> Fix $ NLet (bindings <> newBindings) e'
-  NSet    bindings -> Fix $ NSet (bindings <> newBindings)
-  NRecSet bindings -> Fix $ NRecSet (bindings <> newBindings)
-  _                -> error "Can only append bindings to a set or a let"
+  NLet bindings e'    -> Fix $ NLet (bindings <> newBindings) e'
+  NSet recur bindings -> Fix $ NSet recur (bindings <> newBindings)
+  _                   -> error "Can only append bindings to a set or a let"
 
 -- | Applies a transformation to the body of a nix function.
 modifyFunctionBody :: (NExpr -> NExpr) -> NExpr -> NExpr
@@ -182,11 +182,11 @@ letE varName varExpr = letsE [(varName, varExpr)]
 
 -- | Make an attribute set (non-recursive).
 attrsE :: [(Text, NExpr)] -> NExpr
-attrsE pairs = Fix $ NSet (map (uncurry bindTo) pairs)
+attrsE pairs = Fix $ NSet NNonRecursive (map (uncurry bindTo) pairs)
 
 -- | Make an attribute set (recursive).
 recAttrsE :: [(Text, NExpr)] -> NExpr
-recAttrsE pairs = Fix $ NRecSet (map (uncurry bindTo) pairs)
+recAttrsE pairs = Fix $ NSet NRecursive (map (uncurry bindTo) pairs)
 
 -- | Logical negation.
 mkNot :: NExpr -> NExpr

src/Nix/Expr/Types.hs

@@ -111,10 +111,8 @@ data NExprF r
   -- as @NSym "f"@ and @a@ as @NSym "a"@.
   | NList ![r]
   -- ^ A list literal.
-  | NSet ![Binding r]
-  -- ^ An attribute set literal, not recursive.
-  | NRecSet ![Binding r]
-  -- ^ An attribute set literal, recursive.
+  | NSet !NRecordType ![Binding r]
+  -- ^ An attribute set literal
   | NLiteralPath !FilePath
   -- ^ A path expression, which is evaluated to a store path. The path here
   -- can be relative, in which case it's evaluated relative to the file in
@@ -436,6 +434,16 @@ data NBinaryOp
 instance Serialise NBinaryOp
 #endif
 
+data NRecordType
+  = NNonRecursive
+  | NRecursive
+  deriving (Eq, Ord, Enum, Bounded, Generic, Typeable, Data, Show, Read,
+            NFData, Hashable)
+
+#ifdef MIN_VERSION_serialise
+instance Serialise NRecordType
+#endif
+
 -- | Get the name out of the parameter (there might be none).
 paramName :: Params r -> Maybe VarName
 paramName (Param n       ) = Just n
@@ -488,6 +496,7 @@ instance Binary a => Binary (Params a)
 instance Binary NAtom
 instance Binary NUnaryOp
 instance Binary NBinaryOp
+instance Binary NRecordType
 instance Binary a => Binary (NExprF a)
 
 instance (ToJSON v, ToJSON a) => ToJSON (Antiquoted v a)
@@ -501,6 +510,7 @@ instance ToJSON a => ToJSON (Params a)
 instance ToJSON NAtom
 instance ToJSON NUnaryOp
 instance ToJSON NBinaryOp
+instance ToJSON NRecordType
 instance ToJSON a => ToJSON (NExprF a)
 instance ToJSON NExpr
 
@@ -515,6 +525,7 @@ instance FromJSON a => FromJSON (Params a)
 instance FromJSON NAtom
 instance FromJSON NUnaryOp
 instance FromJSON NBinaryOp
+instance FromJSON NRecordType
 instance FromJSON a => FromJSON (NExprF a)
 instance FromJSON NExpr
 
@@ -538,15 +549,15 @@ ekey
   => NonEmpty Text
   -> SourcePos
   -> Lens' (Fix g) (Maybe (Fix g))
-ekey keys pos f e@(Fix x) | (NSet xs, ann) <- fromNExpr x = case go xs of
+ekey keys pos f e@(Fix x) | (NSet NNonRecursive xs, ann) <- fromNExpr x = case go xs of
   ((v, []      ) : _) -> fromMaybe e <$> f (Just v)
   ((v, r : rest) : _) -> ekey (r :| rest) pos f v
 
   _                   -> f Nothing <&> \case
     Nothing -> e
     Just v ->
       let entry = NamedVar (NE.map StaticKey keys) v pos
-      in  Fix (toNExpr (NSet (entry : xs), ann))
+      in  Fix (toNExpr (NSet NNonRecursive (entry : xs), ann))
  where
   go xs = do
     let keys' = NE.toList keys
@@ -563,8 +574,7 @@ ekey _ _ f e = fromMaybe e <$> f Nothing
 stripPositionInfo :: NExpr -> NExpr
 stripPositionInfo = transport phi
  where
-  phi (NSet    binds  ) = NSet (map go binds)
-  phi (NRecSet binds  ) = NRecSet (map go binds)
+  phi (NSet recur binds) = NSet recur (map go binds)
   phi (NLet binds body) = NLet (map go binds) body
   phi x                 = x
 

src/Nix/Expr/Types/Annotated.hs

@@ -210,11 +210,8 @@ pattern NStr_ ann x = Compose (Ann ann (NStr x))
 pattern NList_ :: SrcSpan -> [r] -> NExprLocF r
 pattern NList_ ann x = Compose (Ann ann (NList x))
 
-pattern NSet_ :: SrcSpan -> [Binding r] -> NExprLocF r
-pattern NSet_ ann x = Compose (Ann ann (NSet x))
-
-pattern NRecSet_ :: SrcSpan -> [Binding r] -> NExprLocF r
-pattern NRecSet_ ann x = Compose (Ann ann (NRecSet x))
+pattern NSet_ :: SrcSpan -> NRecordType -> [Binding r] -> NExprLocF r
+pattern NSet_ ann recur x = Compose (Ann ann (NSet recur x))
 
 pattern NLiteralPath_ :: SrcSpan -> FilePath -> NExprLocF r
 pattern NLiteralPath_ ann x = Compose (Ann ann (NLiteralPath x))

src/Nix/Parser.hs

@@ -252,7 +252,7 @@ nixLet = annotateLocation1
   -- Let expressions `let {..., body = ...}' are just desugared
   -- into `(rec {..., body = ...}).body'.
   letBody    = (\x -> NSelect x (StaticKey "body" :| []) Nothing) <$> aset
-  aset       = annotateLocation1 $ NRecSet <$> braces nixBinders
+  aset       = annotateLocation1 $ NSet NRecursive <$> braces nixBinders
 
 nixIf :: Parser NExprLoc
 nixIf = annotateLocation1
@@ -418,7 +418,7 @@ keyName = dynamicKey <+> staticKey where
 
 nixSet :: Parser NExprLoc
 nixSet = annotateLocation1 ((isRec <*> braces nixBinders) <?> "set")
-  where isRec = (reserved "rec" $> NRecSet <?> "recursive set") <+> pure NSet
+  where isRec = (reserved "rec" $> NSet NRecursive <?> "recursive set") <+> pure (NSet NNonRecursive)
 
 parseNixFile :: MonadFile m => FilePath -> m (Result NExpr)
 parseNixFile =

src/Nix/Pretty.hs

@@ -235,16 +235,16 @@ exprFNixDoc = \case
       $ vsep
       $ concat
       $ [[lbracket], map (wrapParens appOpNonAssoc) xs, [rbracket]]
-  NSet [] -> simpleExpr $ lbrace <> rbrace
-  NSet xs ->
+  NSet NNonRecursive [] -> simpleExpr $ lbrace <> rbrace
+  NSet NNonRecursive xs ->
     simpleExpr
       $ group
       $ nest 2
       $ vsep
       $ concat
       $ [[lbrace], map prettyBind xs, [rbrace]]
-  NRecSet [] -> simpleExpr $ recPrefix <> lbrace <> rbrace
-  NRecSet xs ->
+  NSet NRecursive [] -> simpleExpr $ recPrefix <> lbrace <> rbrace
+  NSet NRecursive xs ->
     simpleExpr
       $ group
       $ nest 2
@@ -330,7 +330,7 @@ valueToExpr = iterNValue (\_ _ -> thk) phi
   phi (NVConstant' a ) = Fix $ NConstant a
   phi (NVStr'      ns) = mkStr ns
   phi (NVList'     l ) = Fix $ NList l
-  phi (NVSet' s p    ) = Fix $ NSet
+  phi (NVSet' s p    ) = Fix $ NSet NNonRecursive
     [ NamedVar (StaticKey k :| []) v (fromMaybe nullPos (M.lookup k p))
     | (k, v) <- toList s
     ]

src/Nix/Reduce.hs

@@ -210,7 +210,7 @@ reduce base@(NSelect_ _ _ attrs _)
     n@(NamedVar (a' :| _) _ _) | a' == a -> Just n
     _ -> findBind xs attrs
   -- Follow the attrpath recursively in sets.
-  inspectSet (NSet_ _ binds) attrs = case findBind binds attrs of
+  inspectSet (NSet_ _ NNonRecursive binds) attrs = case findBind binds attrs of
     Just (NamedVar _ e _) -> case NE.uncons attrs of
       (_, Just attrs) -> inspectSet (unFix e) attrs
       _               -> pure e
@@ -221,18 +221,18 @@ reduce base@(NSelect_ _ _ attrs _)
 
 -- | Reduce a set by inlining its binds outside of the set
 --   if none of the binds inherit the super set.
-reduce e@(NSet_ ann binds) = do
+reduce e@(NSet_ ann NNonRecursive binds) = do
   let usesInherit = flip any binds $ \case
         Inherit{} -> True
         _         -> False
   if usesInherit
-    then clearScopes @NExprLoc $ Fix . NSet_ ann <$> traverse sequence binds
+    then clearScopes @NExprLoc $ Fix . NSet_ ann NNonRecursive <$> traverse sequence binds
     else Fix <$> sequence e
 
 -- Encountering a 'rec set' construction eliminates any hope of inlining
 -- definitions.
-reduce (NRecSet_ ann binds) =
-  clearScopes @NExprLoc $ Fix . NRecSet_ ann <$> traverse sequence binds
+reduce (NSet_ ann NRecursive binds) =
+  clearScopes @NExprLoc $ Fix . NSet_ ann NRecursive <$> traverse sequence binds
 
 -- Encountering a 'with' construction eliminates any hope of inlining
 -- definitions.
@@ -320,11 +320,9 @@ pruneTree opts = cataM $ \(FlaggedF (b, Compose x)) -> do
 
     NList l | reduceLists opts -> Just $ NList (catMaybes l)
             | otherwise        -> Just $ NList (map (fromMaybe nNull) l)
-    NSet binds | reduceSets opts -> Just $ NSet (mapMaybe sequence binds)
-               | otherwise -> Just $ NSet (map (fmap (fromMaybe nNull)) binds)
-    NRecSet binds
-      | reduceSets opts -> Just $ NRecSet (mapMaybe sequence binds)
-      | otherwise       -> Just $ NRecSet (map (fmap (fromMaybe nNull)) binds)
+    NSet recur binds
+      | reduceSets opts -> Just $ NSet recur (mapMaybe sequence binds)
+      | otherwise -> Just $ NSet recur (map (fmap (fromMaybe nNull)) binds)
 
     NLet binds (Just body@(Fix (Compose (Ann _ x)))) ->
       Just $ case mapMaybe pruneBinding binds of

src/Nix/TH.hs

@@ -43,8 +43,8 @@ freeVars e = case unFix e of
   (NStr         string  ) -> foldMap freeVars string
   (NSym         var     ) -> Set.singleton var
   (NList        list    ) -> foldMap freeVars list
-  (NSet         bindings) -> foldMap bindFree bindings
-  (NRecSet bindings) -> foldMap bindFree bindings \\ foldMap bindDefs bindings
+  (NSet NNonRecursive bindings) -> foldMap bindFree bindings
+  (NSet NRecursive bindings) -> foldMap bindFree bindings \\ foldMap bindDefs bindings
   (NLiteralPath _       ) -> Set.empty
   (NEnvPath     _       ) -> Set.empty
   (NUnary _ expr        ) -> freeVars expr