Simon Jakobi 2020-07-23 02:52:21 +02:00 committed by Anton Latukha
parent f4b116f197
commit 54030284fa
8 changed files with 33 additions and 23 deletions

View File

@ -212,6 +212,20 @@ let
# require n-i >= 0.4. dontCheck helps us avoid conflicts with
# neat-interpolation's test dependencies.
neat-interpolation = pkgs.haskell.lib.dontCheck super.neat-interpolation_0_5_1;
# 2020-07-23 hnix uses multiple functions that are unavailable in
# data-fix < 0.3.
data-fix = haskellPackages.callPackage
({ mkDerivation, base, deepseq, hashable, stdenv }:
mkDerivation {
pname = "data-fix";
version = "0.3.0";
sha256 = "9e59b3ed694b5139316093b3767842e60ad4821858459e7cd763e5773dfa99a0";
libraryHaskellDepends = [ base deepseq hashable ];
homepage = "https://github.com/spell-music/data-fix";
description = "Fixpoint data types";
license = stdenv.lib.licenses.bsd3;
}) {};
};
modifier = drv: pkgs.haskell.lib.overrideCabal drv (attrs: {

View File

@ -873,7 +873,7 @@ library
, bytestring >= 0.10.8 && < 0.11
, comonad >= 5.0.4 && < 5.1
, containers >= 0.5.11.0 && < 0.7
, data-fix >= 0.2.0 && < 0.3
, data-fix >= 0.3.0 && < 0.4
, deepseq >= 1.4.3 && <1.5
, deriving-compat >= 0.3 && < 0.6
, directory >= 1.3.1 && < 1.4

View File

@ -43,7 +43,7 @@ import Data.ByteString ( ByteString )
import qualified Data.ByteString as B
import Data.ByteString.Base16 as Base16
import Data.Char ( isDigit )
import Data.Fix ( cata )
import Data.Fix ( foldFix )
import Data.Foldable ( foldrM )
import qualified Data.HashMap.Lazy as M
import Data.List
@ -196,7 +196,7 @@ builtinsList = sequence
outputsList = map outputToAttrListElement outputs;
in (builtins.head outputsList).value|]
[| cata Eval.eval expr |]
[| foldFix Eval.eval expr |]
)
, add TopLevel "derivationStrict" derivationStrict_

View File

@ -35,7 +35,7 @@ import Data.Aeson.TH
import Data.Binary ( Binary(..) )
import Data.Data
import Data.Eq.Deriving
import Data.Fix
import Data.Fix ( Fix(..), unfoldFix )
import Data.Function ( on )
import Data.Functor.Compose
import Data.Hashable
@ -108,14 +108,10 @@ type NExprLocF = AnnF SrcSpan NExprF
-- | A nix expression with source location at each subexpression.
type NExprLoc = Fix NExprLocF
instance NFData NExprLoc
#ifdef MIN_VERSION_serialise
instance Serialise NExprLoc
#endif
instance Hashable NExprLoc
instance Binary SrcSpan
instance (Binary ann, Binary a) => Binary (Ann ann a)
instance Binary r => Binary (NExprLocF r)
@ -135,7 +131,7 @@ pattern AnnE :: forall ann (g :: * -> *). ann
pattern AnnE ann a = Fix (Compose (Ann ann a))
stripAnnotation :: Functor f => Fix (AnnF ann f) -> Fix f
stripAnnotation = ana (annotated . getCompose . unFix)
stripAnnotation = unfoldFix (annotated . getCompose . unFix)
stripAnn :: AnnF ann f r -> f r
stripAnn = annotated . getCompose

View File

@ -18,7 +18,7 @@ module Nix.Pretty where
import Control.Applicative ( (<|>) )
import Control.Comonad
import Control.Monad.Free
import Data.Fix
import Data.Fix ( Fix(..), foldFix )
import Data.HashMap.Lazy ( toList )
import qualified Data.HashMap.Lazy as M
import qualified Data.HashSet as HashSet
@ -190,7 +190,7 @@ prettyAtom :: NAtom -> NixDoc ann
prettyAtom atom = simpleExpr $ pretty $ unpack $ atomText atom
prettyNix :: NExpr -> Doc ann
prettyNix = withoutParens . cata exprFNixDoc
prettyNix = withoutParens . foldFix exprFNixDoc
instance HasCitations1 m v f
=> HasCitations m v (NValue' t f m a) where

View File

@ -43,7 +43,7 @@ import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Monad.State.Strict
import Data.Fix
import Data.Fix ( Fix(..), foldFix, foldFixM )
-- import Data.Foldable
import Data.HashMap.Lazy ( HashMap )
import qualified Data.HashMap.Lazy as M
@ -117,12 +117,12 @@ staticImport pann path = do
x' = Fix (NLet_ span [cur] x)
modify (M.insert path x')
local (const (Just path, emptyScopes @m @NExprLoc)) $ do
x'' <- cata reduce x'
x'' <- foldFix reduce x'
modify (M.insert path x'')
return x''
-- gatherNames :: NExprLoc -> HashSet VarName
-- gatherNames = cata $ \case
-- gatherNames = foldFix $ \case
-- NSym_ _ var -> S.singleton var
-- Compose (Ann _ x) -> fold x
@ -132,7 +132,7 @@ reduceExpr mpath expr =
(`evalStateT` M.empty)
. (`runReaderT` (mpath, emptyScopes))
. runReducer
$ cata reduce expr
$ foldFix reduce expr
reduce
:: forall m
@ -173,7 +173,7 @@ reduce (NBinary_ bann NApp fun arg) = fun >>= \case
Fix (NAbs_ _ (Param name) body) -> do
x <- arg
pushScope (M.singleton name x) (cata reduce body)
pushScope (M.singleton name x) (foldFix reduce body)
f -> Fix . NBinary_ bann NApp f <$> arg
@ -299,15 +299,15 @@ instance Show (f r) => Show (FlaggedF f r) where
type Flagged f = Fix (FlaggedF f)
flagExprLoc :: (MonadIO n, Traversable f) => Fix f -> n (Flagged f)
flagExprLoc = cataM $ \x -> do
flagExprLoc = foldFixM $ \x -> do
flag <- liftIO $ newIORef False
pure $ Fix $ FlaggedF (flag, x)
-- stripFlags :: Functor f => Flagged f -> Fix f
-- stripFlags = cata $ Fix . snd . flagged
-- stripFlags = foldFix $ Fix . snd . flagged
pruneTree :: MonadIO n => Options -> Flagged NExprLocF -> n (Maybe NExprLoc)
pruneTree opts = cataM $ \(FlaggedF (b, Compose x)) -> do
pruneTree opts = foldFixM $ \(FlaggedF (b, Compose x)) -> do
used <- liftIO $ readIORef b
pure $ if used then Fix . Compose <$> traverse prune x else Nothing
where
@ -414,7 +414,7 @@ reducingEvalExpr
-> m (NExprLoc, Either r a)
reducingEvalExpr eval mpath expr = do
expr' <- flagExprLoc =<< liftIO (reduceExpr mpath expr)
eres <- catch (Right <$> cata (addEvalFlags eval) expr') (pure . Left)
eres <- catch (Right <$> foldFix (addEvalFlags eval) expr') (pure . Left)
opts :: Options <- asks (view hasLens)
expr'' <- pruneTree opts expr'
return (fromMaybe nNull expr'', eres)

View File

@ -39,7 +39,7 @@ import Control.Monad.Reader
import Control.Monad.Ref
import Control.Monad.ST
import Control.Monad.State.Strict
import Data.Fix ( cata )
import Data.Fix ( foldFix )
import Data.Foldable
import qualified Data.HashMap.Lazy as M
import Data.List ( delete
@ -564,7 +564,7 @@ instance MonadInfer m => ToValue Bool (InferT s m) (Judgment s) where
toValue _ = pure $ Judgment As.empty [] typeBool
infer :: MonadInfer m => NExpr -> InferT s m (Judgment s)
infer = cata Eval.eval
infer = foldFix Eval.eval
inferTop :: Env -> [(Text, NExpr)] -> Either InferError Env
inferTop env [] = Right env

View File

@ -143,7 +143,7 @@ equivUpToNormalization :: NExpr -> NExpr -> Bool
equivUpToNormalization x y = normalize x == normalize y
normalize :: NExpr -> NExpr
normalize = cata $ \case
normalize = foldFix $ \case
NConstant (NInt n) | n < 0 ->
Fix (NUnary NNeg (Fix (NConstant (NInt (negate n)))))
NConstant (NFloat n) | n < 0 ->