nova-nix-0.8.0.0: src/Nix/Eval/Types.hs
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
-- | Shared types for the Nix evaluator.
--
-- Extracted into its own module so that 'Nix.Eval.Operator',
-- 'Nix.Eval.StringInterp', and 'Nix.Builtins' can all reference
-- 'NixValue', 'Thunk', and 'Env' without creating import cycles.
module Nix.Eval.Types
( -- * Values
NixValue (..),
CompiledRegex (..),
Thunk (..),
readThunkValue,
-- * Attribute sets (C-backed sorted arrays)
AttrSet (..),
CAttrSet,
attrSetLookup,
attrSetKeys,
attrSetToMap,
attrSetFromMap,
attrSetMember,
attrSetNull,
attrSetSize,
attrSetElems,
attrSetToAscList,
attrSetMapWithKey,
attrSetRemoveKeys,
attrSetUnionWith,
buildCAttrSetKeys,
fillCAttrSetValues,
-- * Lists (C-backed)
CList (..),
emptyCList,
clistFromThunks,
clistThunks,
clistLen,
-- * String context
StringContextElement (..),
StringContext (..),
emptyContext,
mkStr,
mkStrBytes,
bytesToTextLossy,
marshalStringContext,
unmarshalStringContext,
-- * Environment
Env (..),
NnEnv,
emptyEnv,
envLookup,
envLookupResolved,
envFromSlots,
pushWithScope,
lookupWithScopes,
withScopesForCapture,
envWithScopesRaw,
checkedCPtr,
newCEnv,
newMinimalEnv,
-- * Eval-time formals (re-exported from EvalFormals)
EvalFormals (..),
EvalFormal (..),
-- * Thunk operations
mkThunk,
mkSyntheticThunk,
cheapThunk,
cheapThunkBc,
mkThunkBc,
evaluated,
thunkSameRef,
thunkToCPtr,
buildCSlots,
allocCSlots,
fillCSlots,
-- * Lambda marshalling
marshalLambda,
unmarshalLambdaValue,
-- * Display
typeName,
-- * C thunk-state and value tags (mirror cbits/nn_thunk.h)
pattern ThunkPending,
pattern ThunkComputed,
pattern ThunkBlackhole,
pattern ValueInt,
pattern ValueFloat,
pattern ValueBool,
pattern ValueNull,
pattern ValueStr,
pattern ValuePath,
pattern ValueList,
pattern ValueAttrs,
pattern ValueCtxStr,
pattern ValueLambda,
-- * Evaluation monad
MonadEval (..),
PureEval,
runPureEval,
storePathOrThrow,
)
where
import Control.Monad (forM_)
import Data.Bits (shiftL, (.&.), (.|.))
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Int (Int64)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Text.Encoding.Error (lenientDecode)
import Data.Word (Word32, Word64, Word8)
import Foreign.Ptr (Ptr, castPtr, nullPtr, ptrToWordPtr)
import Foreign.StablePtr (castPtrToStablePtr, castStablePtrToPtr, deRefStablePtr, newStablePtr)
import Foreign.Storable (peekElemOff, pokeElemOff)
import GHC.Float (castWord64ToDouble)
import Nix.Derivation (Derivation)
import Nix.Eval.CAttrSet (CAttrSet, cattrsetFreeze, cattrsetGetKey, cattrsetGetValue, cattrsetIndex, cattrsetInsert, cattrsetKeys, cattrsetLookup, cattrsetNew, cattrsetRemoveKeys, cattrsetSetValue, cattrsetSize)
import Nix.Eval.CBytecode (cbcArg1, cbcArg2, cbcCountedPayload, cbcData, cbcOpcode, cbcShortArg, pattern OpList, pattern OpLitBool, pattern OpLitFloat, pattern OpLitInt, pattern OpLitNull, pattern OpLitPath, pattern OpLitUri, pattern OpResolvedVar, pattern OpStr)
import Nix.Eval.CCtxStr (CCtxStrPtr, cctxstrCtxCount, cctxstrElemHash, cctxstrElemName, cctxstrElemOutput, cctxstrElemTag, cctxstrNew, cctxstrSetAllOutputs, cctxstrSetDrvOutput, cctxstrSetPlain, cctxstrText)
import Nix.Eval.CEnv (NnEnv, cenvAllocSlots, cenvAllocWithScopes, cenvEmpty, cenvFromSlots, cenvLazyScope, cenvLookupResolved, cenvNew, cenvNewMinimal, cenvParent, cenvPushWith, cenvRootScope, cenvSlotCount, cenvWithCount, cenvWithScopes)
import Nix.Eval.CLambda (clambdaAllowExtra, clambdaBody, clambdaEntryDefault, clambdaEntryHasDefault, clambdaEntryName, clambdaEnv, clambdaFormalCount, clambdaFormalsType, clambdaNameSym, clambdaNew, clambdaSetEntry)
import Nix.Eval.CList (CList (..), clistFromThunks, clistLen, clistThunks, emptyCList)
import Nix.Eval.CThunk (CThunkPtr, cthunkGetAttrs, cthunkGetBcIdx, cthunkGetBool, cthunkGetCtxStr, cthunkGetFloat, cthunkGetInt, cthunkGetList, cthunkGetPath, cthunkGetStr, cthunkNewBc, cthunkNewComputed, cthunkNewComputedAttrs, cthunkNewComputedBool, cthunkNewComputedCtxStr, cthunkNewComputedFloat, cthunkNewComputedInt, cthunkNewComputedLambda, cthunkNewComputedList, cthunkNewComputedNull, cthunkNewComputedPath, cthunkNewComputedStr, cthunkPayload, cthunkState, cthunkValueTag)
import Nix.Eval.CanonPath (canonPathValue)
import Nix.Eval.Compile (compileExpr, compileFormalsToEval)
import Nix.Eval.EvalFormals (EvalFormal (..), EvalFormals (..))
import Nix.Eval.Symbol (Symbol (..), symbolBytes, symbolIntern, symbolInternBytes, symbolText)
import Nix.Expr.Types (CaptureInfo (..), Expr (..), NixAtom (..))
import Nix.Store.Path (StorePath, StorePathNameError, storePathNameErrorText)
import Nix.Store.Path.Internal (StorePath (StorePath))
import System.IO.Unsafe (unsafePerformIO)
import qualified Text.Regex.TDFA as RE
-- ---------------------------------------------------------------------------
-- Compiled regex
-- ---------------------------------------------------------------------------
-- | Compiled regex with Eq/Show based on the source pattern bytes.
-- Carries the pre-compiled 'RE.Regex' alongside the original pattern
-- so that partial application of @builtins.match@ / @builtins.split@
-- avoids recompiling the same pattern on every invocation. The pattern
-- is the raw byte string the regex was compiled from: upstream regexes
-- run over bytes, so byte-identical patterns are the sharing key.
data CompiledRegex = CompiledRegex !ByteString RE.Regex
instance Eq CompiledRegex where
CompiledRegex a _ == CompiledRegex b _ = a == b
instance Show CompiledRegex where
show (CompiledRegex pat _) = "CompiledRegex " <> show pat
-- ---------------------------------------------------------------------------
-- String context
-- ---------------------------------------------------------------------------
-- | A single element of string context, tracking where a string
-- references store paths.
data StringContextElement
= -- | Plain store path reference (inputSrcs).
SCPlain !StorePath
| -- | Derivation output reference (inputDrvs): .drv path + output name.
SCDrvOutput !StorePath !Text
| -- | All outputs of a derivation (for drvPath itself).
SCAllOutputs !StorePath
deriving (Eq, Ord, Show)
-- | Context carried by Nix strings, tracking store path dependencies.
newtype StringContext = StringContext {unStringContext :: Set StringContextElement}
deriving (Eq, Ord, Show, Semigroup, Monoid)
-- | Empty string context (alias for 'mempty').
emptyContext :: StringContext
emptyContext = mempty
-- | Smart constructor for context-free strings from 'Text'.
-- Encodes to the UTF-8 bytes that ARE the string's value: a Nix string
-- is a byte string, and every Text-producing site goes through here.
mkStr :: Text -> NixValue
mkStr t = VStr (TE.encodeUtf8 t) emptyContext
-- | Smart constructor for context-free strings from raw bytes
-- (@builtins.readFile@, substring slices - anything already byte-shaped).
mkStrBytes :: ByteString -> NixValue
mkStrBytes b = VStr b emptyContext
-- | Decode string-value bytes for DISPLAY ONLY (trace output, error
-- messages, value pretty-printing): invalid UTF-8 becomes U+FFFD.
-- Never feed the result back into a value, a hash, or an attr name -
-- identity-bearing boundaries decode strictly and error instead.
bytesToTextLossy :: ByteString -> Text
bytesToTextLossy = TE.decodeUtf8With lenientDecode
-- ---------------------------------------------------------------------------
-- Thunks
-- ---------------------------------------------------------------------------
-- | A thunk: a C arena-allocated memoization cell.
--
-- Each thunk points to an @nn_thunk_t@ in the C arena.
-- On first force, the cell transitions PENDING to BLACKHOLE to COMPUTED,
-- which detects infinite recursion (BLACKHOLE) and drops the Expr/Env
-- references - matching real Nix which mutates thunks in-place.
--
-- The C thunk is allocated via 'unsafePerformIO' in 'mkThunk' (same
-- pattern as the former IORef-based approach) so that knot-tying works
-- unchanged. Arena pointers remain valid until 'cthunkDestroy'.
newtype Thunk = Thunk {unThunk :: CThunkPtr}
instance Show Thunk where
show (Thunk ptr) =
case unsafePerformIO (cthunkState ptr) of
ThunkComputed -> case readThunkValue (Thunk ptr) of
Just val -> "Thunk (" ++ show val ++ ")"
Nothing -> "Thunk <computed?>"
ThunkPending -> "Thunk <pending>"
ThunkBlackhole -> "Thunk <blackhole>"
_ -> "Thunk <unknown>"
-- | Equality: pointer identity fast path, then value comparison for
-- COMPUTED thunks. Only used in tests on non-recursive structures.
instance Eq Thunk where
(Thunk p1) == (Thunk p2)
| p1 == p2 = True
| otherwise = case (readThunkValue (Thunk p1), readThunkValue (Thunk p2)) of
(Just v1, Just v2) -> v1 == v2
_ -> False
-- | Named constants for the C thunk-state byte and value-tag byte, mirroring
-- the @NN_THUNK_*@ / @NN_VALUE_*@ macros in @cbits\/nn_thunk.h@. Bidirectional
-- pattern synonyms over literals, so a @case@ on a tag keeps the jump-table
-- compilation a bare-literal @case@ gets, while the three thunk-dispatch sites
-- ('readThunkValue', @PureEval@'s 'forceThunk', and @Nix.Eval.IO@'s
-- @readComputed@) share one source of truth instead of triplicating literals.
-- These MUST stay in lockstep with @cbits\/nn_thunk.h@. The remaining value
-- tag (PTR, a StablePtr payload) is the wildcard at each dispatch site.
pattern ThunkPending, ThunkComputed, ThunkBlackhole :: Word8
pattern ThunkPending = 0
pattern ThunkComputed = 1
pattern ThunkBlackhole = 2
-- | Value-kind tags for the C value layout, mirroring @cbits\/nn_thunk.h@.
-- The tag selects which payload a computed (VALUE) thunk carries.
pattern ValueInt, ValueFloat, ValueBool, ValueNull, ValueStr, ValuePath, ValueList, ValueAttrs, ValueCtxStr, ValueLambda :: Word8
pattern ValueInt = 0
pattern ValueFloat = 1
pattern ValueBool = 2
pattern ValueNull = 3
pattern ValueStr = 4
pattern ValuePath = 5
pattern ValueList = 6
pattern ValueAttrs = 7
pattern ValueCtxStr = 8
pattern ValueLambda = 9
-- | Read a COMPUTED thunk's value without forcing.
-- Returns 'Nothing' for PENDING or BLACKHOLE thunks.
-- Uses 'unsafePerformIO' - safe because C reads are idempotent.
readThunkValue :: Thunk -> Maybe NixValue
readThunkValue (Thunk ptr) =
unsafePerformIO $ do
state <- cthunkState ptr
if state /= ThunkComputed
then pure Nothing
else do
tag <- cthunkValueTag ptr
fmap Just $ case tag of
ValueInt -> VInt <$> cthunkGetInt ptr
ValueFloat -> VFloat <$> cthunkGetFloat ptr
ValueBool -> (\b -> VBool (b /= 0)) <$> cthunkGetBool ptr
ValueNull -> pure VNull
ValueStr -> (\sym -> VStr (symbolBytes (Symbol sym)) emptyContext) <$> cthunkGetStr ptr
ValuePath -> VPath . symbolText . Symbol <$> cthunkGetPath ptr
ValueList -> do
listPtr <- cthunkGetList ptr
pure (VList (CList (castPtr listPtr)))
ValueAttrs -> VAttrs . AttrSet . castPtr <$> cthunkGetAttrs ptr
ValueCtxStr -> do
csptr <- cthunkGetCtxStr ptr
uncurry VStr <$> unmarshalStringContext (castPtr csptr)
ValueLambda -> do
lamRaw <- cthunkPayload ptr
unmarshalLambdaValue (castPtr lamRaw)
_ {- PTR -} -> do
payload <- cthunkPayload ptr
deRefStablePtr (castPtrToStablePtr payload)
-- | A Nix value - the result of evaluating an expression.
data NixValue
= -- | 64-bit signed integer (matching Nix semantics).
VInt !Int64
| -- | Floating-point.
VFloat !Double
| -- | Boolean.
VBool !Bool
| -- | The null value.
VNull
| -- | String with dependency context. The payload is a BYTE string,
-- as upstream: @stringLength@/@substring@ index bytes, regexes match
-- bytes, and @readFile@ carries raw file bytes (so invalid UTF-8 is
-- representable). Text enters via 'mkStr' (UTF-8 encode) and leaves
-- through explicit decode at boundaries (attr names strictly, display
-- lossily via 'bytesToTextLossy').
VStr !ByteString !StringContext
| -- | Path.
VPath !Text
| -- | List of thunks (lazy elements), backed by C array.
VList !CList
| -- | Attribute set: unified lazy/eager representation.
VAttrs !AttrSet
| -- | Lambda closure: captures environment, formals, body bytecode index.
VLambda !Env !EvalFormals !Word32
| -- | A realized derivation (build recipe).
VDerivation !Derivation
| -- | Built-in function, dispatched by name.
-- Accumulated args support curried partial application.
VBuiltin !Text ![NixValue]
| -- | Pre-compiled regex carried in a partially-applied builtin.
-- Internal only - never exposed to Nix code directly.
VCompiledRegex !CompiledRegex
deriving (Eq, Show)
-- ---------------------------------------------------------------------------
-- Attribute sets (C-backed sorted arrays)
-- ---------------------------------------------------------------------------
-- | Attribute set backed by a C-allocated sorted key-value array.
--
-- All keys are interned symbols; values are CThunkPtrs in a parallel
-- array. O(log n) binary search on contiguous memory for lookup.
-- Replaces the former EagerAttrs\/LazyAttrs\/MappedAttrs\/CAttrs ADT
-- with a single C-backed representation - all attr set data lives off
-- the GHC heap, dramatically reducing GC pressure for large evaluations.
newtype AttrSet = AttrSet {unAttrSet :: CAttrSet}
instance Eq AttrSet where
a == b = attrSetToMap a == attrSetToMap b
instance Show AttrSet where
show (AttrSet cset) =
let n = unsafePerformIO (cattrsetSize cset)
in "<attrset " ++ show n ++ " entries>"
-- | Look up a single key via symbol interning + C binary search.
-- Uses 'unsafePerformIO' - safe because symbolIntern and cattrsetLookup
-- are idempotent (same key always yields same symbol and same result).
attrSetLookup :: Text -> AttrSet -> Maybe Thunk
attrSetLookup key (AttrSet cset) =
unsafePerformIO $ do
sym <- symbolIntern key
mptr <- cattrsetLookup cset sym
pure (fmap Thunk mptr)
-- | All keys in sorted order (symbol text from C).
attrSetKeys :: AttrSet -> [Text]
attrSetKeys (AttrSet cset) =
map symbolText (unsafePerformIO (cattrsetKeys cset))
-- | Check key membership without materializing thunks.
attrSetMember :: Text -> AttrSet -> Bool
attrSetMember key (AttrSet cset) =
unsafePerformIO $ do
sym <- symbolIntern key
midx <- cattrsetIndex cset sym
pure (case midx of Nothing -> False; Just _ -> True)
-- | Check if the attribute set is empty.
attrSetNull :: AttrSet -> Bool
attrSetNull (AttrSet cset) =
unsafePerformIO (cattrsetSize cset) == 0
-- | Number of attributes.
attrSetSize :: AttrSet -> Int
attrSetSize (AttrSet cset) =
fromIntegral (unsafePerformIO (cattrsetSize cset))
-- | Full materialization: build a 'Map Text Thunk' from all entries.
-- Iterates the C array and builds a Haskell Map. Expensive on large
-- sets - avoid on the hot path.
attrSetToMap :: AttrSet -> Map Text Thunk
attrSetToMap (AttrSet cset) =
unsafePerformIO $ do
n <- cattrsetSize cset
if n == 0
then pure Map.empty
else do
pairs <- mapM materializeEntry [0 .. n - 1]
pure (Map.fromList pairs)
where
materializeEntry i = do
sym <- cattrsetGetKey cset i
ptr <- cattrsetGetValue cset i
pure (symbolText sym, Thunk ptr)
-- | All thunk values (materialized).
attrSetElems :: AttrSet -> [Thunk]
attrSetElems = Map.elems . attrSetToMap
-- | Sorted key-value pairs (materialized).
attrSetToAscList :: AttrSet -> [(Text, Thunk)]
attrSetToAscList = Map.toAscList . attrSetToMap
-- | Map a function over all key-value pairs, building a new CAttrSet.
-- Materializes the source set, applies @f@ to each entry, and rebuilds.
attrSetMapWithKey :: (Text -> Thunk -> Thunk) -> AttrSet -> AttrSet
attrSetMapWithKey f attrs = attrSetFromMap (Map.mapWithKey f (attrSetToMap attrs))
-- | Remove a list of keys, returning a new CAttrSet.
-- Uses the C-side @nn_attrset_remove_keys@ for O(n) removal.
{-# NOINLINE attrSetRemoveKeys #-}
attrSetRemoveKeys :: [Text] -> AttrSet -> AttrSet
attrSetRemoveKeys keys (AttrSet cset) = unsafePerformIO $ do
syms <- mapM symbolIntern keys
newSet <- cattrsetRemoveKeys cset syms
pure (AttrSet newSet)
-- | Union two attribute sets with a combining function.
-- Materializes both to Maps, applies the combining function, rebuilds.
attrSetUnionWith :: (Thunk -> Thunk -> Thunk) -> AttrSet -> AttrSet -> AttrSet
attrSetUnionWith f a b = attrSetFromMap (Map.unionWith f (attrSetToMap a) (attrSetToMap b))
-- | Build a CAttrSet from a Haskell 'Map'. Interns all keys as symbols,
-- inserts key-value pairs, freezes (sort + dedup). The canonical entry
-- point for all attribute set construction.
--
-- Uses 'unsafePerformIO' with @NOINLINE@ - safe because C allocation
-- is idempotent and the resulting CAttrSet is referentially transparent.
{-# NOINLINE attrSetFromMap #-}
attrSetFromMap :: Map Text Thunk -> AttrSet
attrSetFromMap m = m `seq` unsafePerformIO $ do
let pairs = Map.toList m
n = fromIntegral (length pairs)
cset <- cattrsetNew n
forM_ pairs $ \(key, Thunk ptr) -> do
sym <- symbolIntern key
cattrsetInsert cset sym ptr
cattrsetFreeze cset
pure (AttrSet cset)
-- | Allocate a CAttrSet skeleton with keys only (NULL values).
-- Used for two-phase construction in @rec {}@ and @let@ (knot-tying):
-- keys are known before thunks, so the CAttrSet is built first, then
-- values are filled via 'fillCAttrSetValues'.
{-# NOINLINE buildCAttrSetKeys #-}
buildCAttrSetKeys :: [Text] -> CAttrSet
buildCAttrSetKeys keys = unsafePerformIO $ do
let n = fromIntegral (length keys)
cset <- cattrsetNew n
forM_ keys $ \key -> do
sym <- symbolIntern key
cattrsetInsert cset sym nullPtr
cattrsetFreeze cset
pure cset
-- | Fill values into a pre-allocated CAttrSet (two-phase construction).
-- Looks up each key's index and writes the CThunkPtr at that position.
-- Keys not found in the CAttrSet are silently ignored (should not happen
-- in correct knot-tying code).
{-# NOINLINE fillCAttrSetValues #-}
fillCAttrSetValues :: CAttrSet -> Map Text Thunk -> ()
fillCAttrSetValues cset thunkMap = unsafePerformIO $
forM_ (Map.toList thunkMap) $ \(key, Thunk ptr) -> do
sym <- symbolIntern key
midx <- cattrsetIndex cset sym
case midx of
Just idx -> cattrsetSetValue cset idx ptr
Nothing -> pure ()
-- | Evaluation environment - C-backed scope chain.
--
-- Arena-allocated @nn_env_t@ struct (48 bytes, zero GC overhead).
-- All env data (slots, lazy scope, parent, with-scopes) lives in C.
-- Haskell holds only the pointer. Variable lookup has two paths:
--
-- * 'envLookupResolved': single C call for 'EResolvedVar'
-- * 'envLookup': name-based walk for 'EVar' (lazy scope + with-scopes)
newtype Env = Env (Ptr NnEnv)
-- | Pointer equality: two envs are equal iff they are the same C struct.
instance Eq Env where
Env p1 == Env p2 = p1 == p2
-- | Compact show via C accessors.
instance Show Env where
show (Env envPtr) =
let sc = unsafePerformIO (cenvSlotCount envPtr)
ls = unsafePerformIO (cenvLazyScope envPtr)
par = unsafePerformIO (cenvParent envPtr)
wc = unsafePerformIO (cenvWithCount envPtr)
in "Env{"
++ show sc
++ " slots"
++ (if ls /= nullPtr then ", lazyScope" else "")
++ (if par /= nullPtr then ", parent" else "")
++ ", "
++ show wc
++ " withs}"
-- | Empty environment (no variables in scope).
-- Points to a static global C struct - valid until 'arenaDestroy'.
{-# NOINLINE emptyEnv #-}
emptyEnv :: Env
emptyEnv = Env (unsafePerformIO cenvEmpty)
-- | Fail loudly when a C allocator returns NULL (arena or malloc
-- exhaustion, or a rejected over-large size). The C side signals
-- failure deliberately; deferring the NULL to the next dereference
-- would be undefined behavior in a release build, so convert it into
-- a clean Haskell exception here.
checkedCPtr :: String -> Ptr a -> Ptr a
checkedCPtr site ptr
| ptr == nullPtr = error (site ++ ": C allocation failed")
| otherwise = ptr
-- | General C-backed env constructor.
-- Takes Haskell-level types; converts Maybe to nullPtr internally.
{-# NOINLINE newCEnv #-}
newCEnv :: Ptr CThunkPtr -> Int -> Maybe AttrSet -> Maybe Env -> Ptr (Ptr ()) -> Word32 -> Env
newCEnv slots slotCount lazyScope parent withs withCount =
Env
( checkedCPtr "newCEnv" $
unsafePerformIO
( cenvNew
slots
(fromIntegral slotCount)
(case lazyScope of Nothing -> nullPtr; Just (AttrSet cset) -> castPtr cset)
(case parent of Nothing -> nullPtr; Just (Env p) -> p)
withs
withCount
)
)
-- | Minimal env: slots only, no parent, no with-scopes, no lazy scope.
{-# NOINLINE newMinimalEnv #-}
newMinimalEnv :: Ptr CThunkPtr -> Int -> Env
newMinimalEnv slots n =
Env (checkedCPtr "newMinimalEnv" (unsafePerformIO (cenvNewMinimal slots (fromIntegral n))))
-- | Look up a resolved variable by level and index. Single C call:
-- O(level) parent hops in C, then O(1) array read.
envLookupResolved :: Int -> Int -> Env -> Thunk
envLookupResolved level idx (Env envPtr) =
Thunk (unsafePerformIO (cenvLookupResolved envPtr level idx))
-- | Name-based variable lookup: walk the parent chain checking
-- lazy scopes; fall back to with-scopes (from the starting env).
--
-- Positional slots are NOT searched here - used only for
-- 'EVar' lookups (let\/rec bindings, builtins, with-scopes).
envLookup :: Text -> Env -> Maybe Thunk
envLookup name (Env envPtr) = lexicalLookup envPtr
where
-- With-scopes from the STARTING env (C array)
startWiths = unsafePerformIO (cenvWithScopes envPtr)
startWithCount = unsafePerformIO (cenvWithCount envPtr)
lexicalLookup ep =
let ls = unsafePerformIO (cenvLazyScope ep)
scopeResult =
if ls /= nullPtr
then attrSetLookup name (AttrSet (castPtr ls))
else Nothing
in case scopeResult of
Just val -> Just val
Nothing ->
let par = unsafePerformIO (cenvParent ep)
in if par /= nullPtr
then lexicalLookup par
else lookupWithScopesC name startWiths startWithCount
-- | Walk with-scopes (C array) innermost to outermost.
-- Skips tagged lazy entries (bit 0 set) - those are thunk pointers
-- that can only be resolved by 'evalWithVarScopes' which has monadic
-- 'force'. Defensive: an 'EVar' under a with is either a lexical
-- (barrier) binding or a static global, both found on the parent chain
-- before this fallback fires ('EVar' also blocks closure trimming, so
-- the chain is always intact) - but keep it for safety.
lookupWithScopesC :: Text -> Ptr (Ptr ()) -> Word32 -> Maybe Thunk
lookupWithScopesC _ _ 0 = Nothing
lookupWithScopesC name withArr count = unsafePerformIO $ go 0
where
go i
| i >= fromIntegral count = pure Nothing
| otherwise = do
scopePtr <- peekElemOff withArr i
if ptrToWordPtr scopePtr .&. 1 /= 0
then go (i + 1) -- skip tagged lazy with-scope
else case attrSetLookup name (AttrSet (castPtr scopePtr)) of
Just val -> pure (Just val)
Nothing -> go (i + 1)
-- | Walk with-scopes as a Haskell list (backward-compatible signature).
lookupWithScopes :: Text -> [AttrSet] -> Maybe Thunk
lookupWithScopes _ [] = Nothing
lookupWithScopes name (scope : rest) =
case attrSetLookup name scope of
Just val -> Just val
Nothing -> lookupWithScopes name rest
-- | Create a child env with positional slots (for lambda formals).
-- Inherits with-scopes from the parent. Arena-allocated.
{-# NOINLINE envFromSlots #-}
envFromSlots :: Ptr CThunkPtr -> Int -> Env -> Env
envFromSlots slotsPtr slotCount (Env parentPtr) =
Env (checkedCPtr "envFromSlots" (unsafePerformIO (cenvFromSlots slotsPtr (fromIntegral slotCount) parentPtr)))
-- | Push a with-scope onto the scope chain (innermost position).
-- Allocates a new C env struct with extended with-scopes array.
{-# NOINLINE pushWithScope #-}
pushWithScope :: AttrSet -> Env -> Env
pushWithScope (AttrSet cset) (Env envPtr) =
Env (checkedCPtr "pushWithScope" (unsafePerformIO (cenvPushWith envPtr (castPtr cset))))
-- | Read with-scopes array pointer and count from a C env.
{-# NOINLINE envWithScopesRaw #-}
envWithScopesRaw :: Env -> (Ptr (Ptr ()), Word32)
envWithScopesRaw (Env envPtr) = unsafePerformIO $ do
withs <- cenvWithScopes envPtr
count <- cenvWithCount envPtr
pure (withs, count)
-- | Build with-scopes for a trimmed env that needs with-scope access
-- ('CapturesWithScopes'). Appends the root scope (builtins) as the
-- outermost entry so 'EWithVar' can fall back to builtins without
-- retaining the parent chain. Returns C array + count.
{-# NOINLINE withScopesForCapture #-}
withScopesForCapture :: Env -> (Ptr (Ptr ()), Word32)
withScopesForCapture (Env envPtr) = unsafePerformIO $ do
rootPtr <- cenvRootScope envPtr
existingWiths <- cenvWithScopes envPtr
existingCount <- cenvWithCount envPtr
if rootPtr == nullPtr
then pure (existingWiths, existingCount)
else do
-- existingCount sits far below 2^32 (the C side caps the array
-- allocation at UINT32_MAX bytes), so the increment cannot wrap.
let newCount = existingCount + 1
arr <- checkedCPtr "withScopesForCapture" <$> cenvAllocWithScopes newCount
forM_ [0 .. fromIntegral existingCount - 1] $ \i -> do
val <- peekElemOff existingWiths i
pokeElemOff arr i val
-- The root scope goes last: it is the outermost.
pokeElemOff arr (fromIntegral existingCount) rootPtr
pure (arr, newCount)
-- | Create an unevaluated thunk with a fresh C arena-allocated cell.
--
-- Compiles the Expr to bytecode and stores (bc_idx, env_ptr) in the
-- C thunk - no StablePtr, zero GHC heap pressure for pending thunks.
-- The cell is allocated via 'unsafePerformIO' - safe because C
-- allocation is a pure side effect, and the @NOINLINE@ + @seq@
-- pattern prevents GHC from floating the allocation to a shared
-- top-level CAF.
mkThunk :: Env -> Expr -> Thunk
mkThunk env thunkExpr =
Thunk (newBcThunkPtr thunkExpr env)
-- | Like 'mkThunk' but for synthetic thunks that reuse the same 'Expr'
-- (e.g. @EApp (EResolvedVar 0 0) (EResolvedVar 0 1)@ in 'deferApply').
-- Uses the env pointer for cell uniqueness instead of the expression,
-- since GHC's full-laziness transform would otherwise float the shared
-- expr to a CAF and all thunks would get the same cell.
--
-- Must only be called with freshly-constructed envs (not knot-tied
-- recursive envs), since it forces the env pointer to WHNF.
mkSyntheticThunk :: Env -> Expr -> Thunk
mkSyntheticThunk env@(Env envPtr) thunkExpr =
Thunk (newSyntheticBcThunkPtr envPtr thunkExpr env)
-- | Like 'mkThunk' but avoids C arena allocation for trivial expressions.
-- Resolved variables reuse the existing thunk from the env (no wrapper).
-- Literals use inline C scalars (no StablePtr).
-- Lambdas compile formals+body to bytecode and produce VLambda directly.
-- Everything else falls back to 'mkThunk'.
cheapThunk :: Env -> Expr -> Thunk
cheapThunk env (EResolvedVar level idx) = envLookupResolved level idx env
cheapThunk _ (ELit (NixInt n)) = Thunk (newComputedIntPtr n)
cheapThunk _ (ELit (NixFloat n)) = Thunk (newComputedFloatPtr n)
cheapThunk _ (ELit (NixBool b)) = Thunk (newComputedBoolPtr (if b then 1 else 0))
cheapThunk _ (ELit NixNull) = Thunk newComputedNullPtr
cheapThunk env (ELambda formals body NoCaptureInfo) =
let bodyBcIdx = unsafePerformIO (compileExpr body)
evalFormals = unsafePerformIO (compileFormalsToEval formals)
in evaluated (VLambda env evalFormals bodyBcIdx)
cheapThunk env (ELambda formals body (Captures captureList)) =
let (slotsPtr, slotCount) = buildCSlots [envLookupResolved lvl idx env | (lvl, idx) <- captureList]
trimmedEnv = newMinimalEnv slotsPtr slotCount
bodyBcIdx = unsafePerformIO (compileExpr body)
evalFormals = unsafePerformIO (compileFormalsToEval formals)
in evaluated (VLambda trimmedEnv evalFormals bodyBcIdx)
cheapThunk env (ELambda formals body (CapturesWithScopes captureList)) =
let (slotsPtr, slotCount) = buildCSlots [envLookupResolved lvl idx env | (lvl, idx) <- captureList]
(withArr, withCount) = withScopesForCapture env
trimmedEnv = newCEnv slotsPtr slotCount Nothing Nothing withArr withCount
bodyBcIdx = unsafePerformIO (compileExpr body)
evalFormals = unsafePerformIO (compileFormalsToEval formals)
in evaluated (VLambda trimmedEnv evalFormals bodyBcIdx)
cheapThunk env expr = mkThunk env expr
-- | Create a pending thunk from a bytecode index (no compilation needed).
-- Used inside 'evalBytecode' where the bc_idx is already known.
-- The Env is captured LAZILY (for knot-tying in rec attrs / let / matchFormalSet).
mkThunkBc :: Env -> Word32 -> Thunk
mkThunkBc env bcIdx =
Thunk (newBcThunkPtrLazy bcIdx env)
-- | Like 'cheapThunk' but for bytecode indices (used inside evalBytecode).
-- Short-circuits for resolved vars and literals without creating a
-- pending thunk. Everything else falls back to 'mkThunkBc'.
cheapThunkBc :: Env -> Word32 -> Thunk
cheapThunkBc env bcIdx =
case unsafePerformIO (cbcOpcode bcIdx) of
OpResolvedVar ->
let level = fromIntegral (unsafePerformIO (cbcArg1 bcIdx))
idx = fromIntegral (unsafePerformIO (cbcArg2 bcIdx))
in envLookupResolved level idx env
OpLitInt ->
let lo = unsafePerformIO (cbcArg1 bcIdx)
hi = unsafePerformIO (cbcArg2 bcIdx)
w64 = fromIntegral lo .|. (fromIntegral hi `shiftL` 32) :: Word64
in Thunk (newComputedIntPtr (fromIntegral w64 :: Int64))
OpLitFloat ->
let lo = unsafePerformIO (cbcArg1 bcIdx)
hi = unsafePerformIO (cbcArg2 bcIdx)
w64 = fromIntegral lo .|. (fromIntegral hi `shiftL` 32) :: Word64
in Thunk (newComputedFloatPtr (castWord64ToDouble w64))
OpLitBool ->
let flag = unsafePerformIO (cbcShortArg bcIdx)
in Thunk (newComputedBoolPtr (if flag /= 0 then 1 else 0))
OpLitNull -> Thunk newComputedNullPtr
OpLitUri ->
let sym = unsafePerformIO (cbcArg1 bcIdx)
in Thunk (newComputedStrPtr (symbolBytes (Symbol sym)))
OpStr
| Just bytes <- literalStrBytes bcIdx -> Thunk (newComputedStrPtr bytes)
OpLitPath
| Just resolved <- constantPathValue bcIdx -> Thunk (newComputedPathPtr resolved)
OpList
| emptyBcList bcIdx -> Thunk (newComputedThunkPtr (VList emptyCList))
_ -> mkThunkBc env bcIdx
-- | The value of a path literal, when producing it is not work.
--
-- Parsing resolves every relative path literal against the file's directory
-- ('Nix.Expr.Resolve.resolveRelativePaths'), so what reaches here is already
-- absolute and only wants the lexical canonicalisation every path value
-- carries. The exception is a home-relative literal, which parsing leaves
-- alone: expanding it reads @HOME@, and that is an effect this cannot run.
constantPathValue :: Word32 -> Maybe Text
constantPathValue bcIdx
| T.isPrefixOf "~/" text = Nothing
| otherwise = Just (canonPathValue text)
where
text = symbolText (Symbol (unsafePerformIO (cbcArg1 bcIdx)))
-- | Whether a list expression has no elements, and so is the same empty list
-- however many times it is written. Upstream hands back one shared
-- @vEmptyList@ for this rather than a thunk.
emptyBcList :: Word32 -> Bool
emptyBcList bcIdx =
let (count, _) = unsafePerformIO (cbcCountedPayload bcIdx =<< cbcArg1 bcIdx)
in count == 0
-- | @NN_STRPART_LIT@ from @cbits/nn_bytecode.h@: a string part that is
-- literal text rather than an interpolation.
strPartLiteral :: Word32
strPartLiteral = 0
-- | The bytes of a string expression every part of which is literal, or
-- 'Nothing' when one is an interpolation and producing the value is work.
--
-- Upstream draws this line in the parser: a fully literal string folds into
-- an @ExprString@ carrying a ready-made value, and only a string with
-- interpolation survives as @ExprConcatStrings@. The split is made here
-- instead by reading the parts back, because this compiler emits one opcode
-- for both shapes.
--
-- Deliberately not extended to @OpIndStr@, whose common indentation is
-- stripped during evaluation rather than in the parser, so its value is not
-- yet a constant at this point. Upstream can treat one as a constant
-- because its parser has already done that stripping.
literalStrBytes :: Word32 -> Maybe ByteString
literalStrBytes bcIdx =
let (count, dataOff) = unsafePerformIO (cbcCountedPayload bcIdx =<< cbcArg1 bcIdx)
in BS.concat <$> partBytes count dataOff
where
partBytes 0 _ = Just []
partBytes n off
| unsafePerformIO (cbcData off) /= strPartLiteral = Nothing
| otherwise =
let sym = unsafePerformIO (cbcData (off + 1))
in (symbolBytes (Symbol sym) :) <$> partBytes (n - 1 :: Int) (off + 2)
-- | Allocate a fresh C arena thunk cell with bytecode.
--
-- @NOINLINE@ prevents inlining so GHC can't see inside or CSE calls.
-- @seq@ on the expr creates a data dependency that prevents float-out
-- to a top-level CAF - without this, GHC would hoist the
-- @unsafePerformIO@ and share ONE cell across ALL thunks.
--
-- Compiles the Expr to bytecode and stores (bc_idx, StablePtr Env)
-- in the C thunk. The Expr tree is eliminated from the GHC heap -
-- only the StablePtr Env (~16 bytes) remains for knot-tying laziness.
{-# NOINLINE newBcThunkPtr #-}
newBcThunkPtr :: Expr -> Env -> CThunkPtr
newBcThunkPtr expr env =
unsafePerformIO $ expr `seq` do
bcIdx <- compileExpr expr
sp <- newStablePtr env
cthunkNewBc bcIdx (castStablePtrToPtr sp)
-- | Like 'newBcThunkPtr' but keyed on the env's C pointer instead
-- of the expression. Used by 'mkSyntheticThunk' where multiple thunks
-- share the same expression (e.g. 'deferApplyExpr').
{-# NOINLINE newSyntheticBcThunkPtr #-}
newSyntheticBcThunkPtr :: Ptr NnEnv -> Expr -> Env -> CThunkPtr
newSyntheticBcThunkPtr envKey expr env =
unsafePerformIO $ envKey `seq` do
bcIdx <- compileExpr expr
sp <- newStablePtr env
cthunkNewBc bcIdx (castStablePtrToPtr sp)
-- | Allocate a fresh C arena thunk cell from a known bytecode index.
-- No compilation needed - the bc_idx is already available.
--
-- Uses StablePtr for the Env so it stays lazy - essential for
-- knot-tying in recursive attrs, let bindings, and matchFormalSet.
-- The StablePtr points to an Env (newtype around Ptr NnEnv) - ~16
-- bytes on the GHC heap, negligible compared to the Expr trees we
-- eliminated.
{-# NOINLINE newBcThunkPtrLazy #-}
newBcThunkPtrLazy :: Word32 -> Env -> CThunkPtr
newBcThunkPtrLazy bcIdx env =
unsafePerformIO $ bcIdx `seq` do
sp <- newStablePtr env
cthunkNewBc bcIdx (castStablePtrToPtr sp)
-- | Wrap an already-computed value as a thunk.
-- Scalars (int/float/bool/null) use inline C thunks (no StablePtr).
-- Attrs, paths, and context-free strings use C-native tags (no StablePtr).
-- Other complex values fall back to StablePtr-backed C thunks.
evaluated :: NixValue -> Thunk
evaluated (VInt n) = Thunk (newComputedIntPtr n)
evaluated (VFloat d) = Thunk (newComputedFloatPtr d)
evaluated (VBool b) = Thunk (newComputedBoolPtr (if b then 1 else 0))
evaluated VNull = Thunk newComputedNullPtr
evaluated (VAttrs (AttrSet cset)) = Thunk (newComputedAttrsPtr cset)
evaluated (VPath p) = Thunk (newComputedPathPtr p)
evaluated (VStr t ctx)
| ctx == emptyContext = Thunk (newComputedStrPtr t)
| otherwise = Thunk (newComputedCtxStrPtr t ctx)
evaluated (VList cl) = Thunk (newComputedListPtrC cl)
evaluated (VLambda env formals bodyBcIdx) = Thunk (newComputedLambdaPtr env formals bodyBcIdx)
evaluated val = Thunk (newComputedThunkPtr val)
-- | Check if two thunks share the same memoization cell (C pointer
-- equality). When true, both thunks will always produce the same value,
-- so deep equality can short-circuit to 'True' without forcing.
thunkSameRef :: Thunk -> Thunk -> Bool
thunkSameRef (Thunk p1) (Thunk p2) = p1 == p2
-- | Extract the C pointer from a thunk (zero-cost, newtype unwrap).
thunkToCPtr :: Thunk -> CThunkPtr
thunkToCPtr (Thunk ptr) = ptr
-- | Wrap an already-computed 'NixValue' in a C thunk (StablePtr path).
-- Arena-allocated (O(1)). Used for complex values (string, list, attrs, etc.).
{-# NOINLINE newComputedThunkPtr #-}
newComputedThunkPtr :: NixValue -> CThunkPtr
newComputedThunkPtr val =
unsafePerformIO $ val `seq` do
sp <- newStablePtr val
cthunkNewComputed (castStablePtrToPtr sp)
-- | Wrap an int64 in a pre-computed C thunk (inline, no StablePtr).
{-# NOINLINE newComputedIntPtr #-}
newComputedIntPtr :: Int64 -> CThunkPtr
newComputedIntPtr n = unsafePerformIO (cthunkNewComputedInt n)
-- | Wrap a double in a pre-computed C thunk (inline, no StablePtr).
{-# NOINLINE newComputedFloatPtr #-}
newComputedFloatPtr :: Double -> CThunkPtr
newComputedFloatPtr d = unsafePerformIO (cthunkNewComputedFloat d)
-- | Wrap a bool in a pre-computed C thunk (inline, no StablePtr).
{-# NOINLINE newComputedBoolPtr #-}
newComputedBoolPtr :: Word8 -> CThunkPtr
newComputedBoolPtr b = unsafePerformIO (cthunkNewComputedBool b)
-- | Wrap null in a pre-computed C thunk (inline, no StablePtr).
{-# NOINLINE newComputedNullPtr #-}
newComputedNullPtr :: CThunkPtr
newComputedNullPtr = unsafePerformIO cthunkNewComputedNull
-- | Wrap a context-free string in a pre-computed C thunk (interned symbol, no StablePtr).
{-# NOINLINE newComputedStrPtr #-}
newComputedStrPtr :: ByteString -> CThunkPtr
newComputedStrPtr t =
unsafePerformIO $ t `seq` do
Symbol sym <- symbolInternBytes t
cthunkNewComputedStr sym
-- | Wrap a path in a pre-computed C thunk (interned symbol, no StablePtr).
{-# NOINLINE newComputedPathPtr #-}
newComputedPathPtr :: Text -> CThunkPtr
newComputedPathPtr p =
unsafePerformIO $ p `seq` do
Symbol sym <- symbolIntern p
cthunkNewComputedPath sym
-- | Wrap a CList in a pre-computed C thunk (no conversion needed).
{-# NOINLINE newComputedListPtrC #-}
newComputedListPtrC :: CList -> CThunkPtr
newComputedListPtrC (CList clistPtr) =
unsafePerformIO
$ clistPtr
`seq` cthunkNewComputedList (castPtr clistPtr)
-- | Wrap a string with context in a pre-computed C thunk (no StablePtr).
-- Interns the payload bytes and all StorePath fields as symbols, builds nn_ctxstr_t.
{-# NOINLINE newComputedCtxStrPtr #-}
newComputedCtxStrPtr :: ByteString -> StringContext -> CThunkPtr
newComputedCtxStrPtr t ctx =
unsafePerformIO $
t `seq`
ctx `seq` do
ptr <- marshalStringContext t ctx
cthunkNewComputedCtxStr (castPtr ptr)
-- | Wrap a lambda closure in a pre-computed C thunk (no StablePtr).
-- Marshals EvalFormals to nn_lambda_t, stores as tag 9.
{-# NOINLINE newComputedLambdaPtr #-}
newComputedLambdaPtr :: Env -> EvalFormals -> Word32 -> CThunkPtr
newComputedLambdaPtr (Env envPtr) formals bodyBcIdx =
unsafePerformIO $
formals `seq` do
clam <- marshalLambda envPtr formals bodyBcIdx
cthunkNewComputedLambda clam
-- | Marshal Env + EvalFormals + body bc_idx to a C nn_lambda_t.
marshalLambda :: Ptr NnEnv -> EvalFormals -> Word32 -> IO (Ptr ())
marshalLambda envPtr formals bodyBcIdx = case formals of
EFName name -> do
Symbol nameSym <- symbolIntern name
lam <- checkedCPtr "marshalLambda" <$> clambdaNew envPtr bodyBcIdx 0 nameSym 0 0
pure (castPtr lam)
EFSet entries allowExtra -> do
let count = fromIntegral (length entries) :: Word32
extraFlag = if allowExtra then 1 else 0 :: Word8
lam <- checkedCPtr "marshalLambda" <$> clambdaNew envPtr bodyBcIdx 1 0 extraFlag count
fillEntries lam 0 entries
pure (castPtr lam)
EFNamedSet name entries allowExtra -> do
Symbol nameSym <- symbolIntern name
let count = fromIntegral (length entries) :: Word32
extraFlag = if allowExtra then 1 else 0 :: Word8
lam <- checkedCPtr "marshalLambda" <$> clambdaNew envPtr bodyBcIdx 2 nameSym extraFlag count
fillEntries lam 0 entries
pure (castPtr lam)
where
fillEntries _ _ [] = pure ()
fillEntries lam !idx (EvalFormal name defBcIdx : rest) = do
Symbol nameSym <- symbolIntern name
let (hasDef, defIdx) = case defBcIdx of
Nothing -> (0, 0)
Just di -> (1, di)
clambdaSetEntry lam idx nameSym hasDef defIdx
fillEntries lam (idx + 1) rest
-- | Read a C nn_lambda_t back into VLambda.
-- Reconstructs Env (newtype wrap), EvalFormals (from symbol IDs), body bc_idx.
unmarshalLambdaValue :: Ptr () -> IO NixValue
unmarshalLambdaValue rawPtr = do
let lamPtr = castPtr rawPtr
envPtr <- clambdaEnv lamPtr
bodyIdx <- clambdaBody lamPtr
formalsType <- clambdaFormalsType lamPtr
formals <- case formalsType of
0 {- Name -} -> do
nameSym <- clambdaNameSym lamPtr
pure (EFName (symbolText (Symbol nameSym)))
1 {- Set -} -> do
count <- clambdaFormalCount lamPtr
extra <- clambdaAllowExtra lamPtr
entries <- readLambdaEntries lamPtr count
pure (EFSet entries (extra /= 0))
_ {- NamedSet -} -> do
nameSym <- clambdaNameSym lamPtr
count <- clambdaFormalCount lamPtr
extra <- clambdaAllowExtra lamPtr
entries <- readLambdaEntries lamPtr count
pure (EFNamedSet (symbolText (Symbol nameSym)) entries (extra /= 0))
pure (VLambda (Env envPtr) formals bodyIdx)
where
-- Zero-formal set patterns ({}:, { ... }:) store count 0 and a NULL
-- entries array; count - 1 would underflow Word32.
readLambdaEntries lamPtr count
| count == 0 = pure []
| otherwise = mapM (readOneEntry lamPtr) [0 .. count - 1]
readOneEntry lamPtr idx = do
nameSym <- clambdaEntryName lamPtr idx
hasDef <- clambdaEntryHasDefault lamPtr idx
defIdx <- clambdaEntryDefault lamPtr idx
let defMaybe = if hasDef /= 0 then Just defIdx else Nothing
pure (EvalFormal (symbolText (Symbol nameSym)) defMaybe)
-- | Marshal payload bytes + StringContext to a C nn_ctxstr_t. The
-- payload interns byte-level ('symbolInternBytes'); the StorePath and
-- output-name fields are Text and intern as UTF-8.
marshalStringContext :: ByteString -> StringContext -> IO CCtxStrPtr
marshalStringContext textVal (StringContext ctxSet) = do
Symbol textSym <- symbolInternBytes textVal
let elems = Set.toAscList ctxSet
count = fromIntegral (length elems) :: Word32
ptr <- checkedCPtr "marshalStringContext" <$> cctxstrNew textSym count
fillElems ptr 0 elems
pure ptr
where
fillElems _ _ [] = pure ()
fillElems ptr !idx (e : es) = do
marshalElem ptr idx e
fillElems ptr (idx + 1) es
marshalElem eptr eidx (SCPlain (StorePath h n)) = do
Symbol hashSym <- symbolIntern h
Symbol nameSym <- symbolIntern n
cctxstrSetPlain eptr eidx hashSym nameSym
marshalElem eptr eidx (SCDrvOutput (StorePath h n) out) = do
Symbol hashSym <- symbolIntern h
Symbol nameSym <- symbolIntern n
Symbol outSym <- symbolIntern out
cctxstrSetDrvOutput eptr eidx hashSym nameSym outSym
marshalElem eptr eidx (SCAllOutputs (StorePath h n)) = do
Symbol hashSym <- symbolIntern h
Symbol nameSym <- symbolIntern n
cctxstrSetAllOutputs eptr eidx hashSym nameSym
-- | Unmarshal a C nn_ctxstr_t back to (payload bytes, StringContext).
unmarshalStringContext :: CCtxStrPtr -> IO (ByteString, StringContext)
unmarshalStringContext ptr = do
textSym <- cctxstrText ptr
count <- cctxstrCtxCount ptr
let textVal = symbolBytes (Symbol textSym)
-- count - 1 underflows Word32 at 0 (defensive: marshal sites store
-- only non-empty contexts today).
elems <-
if count == 0
then pure []
else mapM (readElem ptr) [0 .. count - 1]
pure (textVal, StringContext (Set.fromList elems))
where
readElem cptr idx = do
tag <- cctxstrElemTag cptr idx
hashSym <- cctxstrElemHash cptr idx
nameSym <- cctxstrElemName cptr idx
-- Raw construction (Nix.Store.Path.Internal): provenance-safe -
-- these symbols were interned from a validated StorePath's own
-- fields by marshalStringContext, so this is a round-trip, not a
-- parse boundary.
let sp = StorePath (symbolText (Symbol hashSym)) (symbolText (Symbol nameSym))
case tag of
0 -> pure (SCPlain sp)
1 -> do
outSym <- cctxstrElemOutput cptr idx
pure (SCDrvOutput sp (symbolText (Symbol outSym)))
_ -> pure (SCAllOutputs sp)
-- | Wrap a CAttrSet in a pre-computed C thunk (pointer, no StablePtr).
{-# NOINLINE newComputedAttrsPtr #-}
newComputedAttrsPtr :: CAttrSet -> CThunkPtr
newComputedAttrsPtr cset =
unsafePerformIO
$ cset
`seq` cthunkNewComputedAttrs (castPtr cset)
-- | Build a C-allocated slot array from a list of 'Thunk' values.
-- Each thunk is converted to 'CThunkPtr' via 'thunkToCPtr'.
-- Returns the C array pointer and the slot count.
-- Uses 'unsafePerformIO' - safe because allocation is idempotent.
{-# NOINLINE buildCSlots #-}
buildCSlots :: [Thunk] -> (Ptr CThunkPtr, Int)
buildCSlots thunks = unsafePerformIO $ do
let n = length thunks
if n == 0
then pure (nullPtr, 0)
else do
arr <- cenvAllocSlots (fromIntegral n)
pokeSlots arr 0 thunks
pure (arr, n)
where
pokeSlots _ _ [] = pure ()
pokeSlots arr i (t : ts) = do
pokeElemOff arr i (thunkToCPtr t)
pokeSlots arr (i + 1) ts
-- | Allocate a C slot array of the given size WITHOUT filling it.
-- Returns 'nullPtr' for size 0. Used by knot-tying sites (rec {},
-- let) where the Env must reference the slot pointer before the
-- thunks are materialized. Caller MUST fill all slots via 'fillCSlots'
-- before any slot is read (e.g. before forcing any thunk).
{-# NOINLINE allocCSlots #-}
allocCSlots :: Int -> Ptr CThunkPtr
allocCSlots 0 = nullPtr
allocCSlots n = unsafePerformIO (cenvAllocSlots (fromIntegral n))
-- | Fill a pre-allocated C slot array with thunks. Each thunk is
-- converted to 'CThunkPtr' via 'thunkToCPtr' and poked at its index.
-- The list length MUST equal the allocated array size.
-- Used after 'allocCSlots' in knot-tying contexts.
{-# NOINLINE fillCSlots #-}
fillCSlots :: Ptr CThunkPtr -> [Thunk] -> ()
fillCSlots arr thunks = unsafePerformIO (go 0 thunks)
where
go _ [] = pure ()
go !i (t : ts) = do
pokeElemOff arr i (thunkToCPtr t)
go (i + 1) ts
-- | Human-readable type name for error messages.
typeName :: NixValue -> Text
typeName val = case val of
VInt _ -> "an integer"
VFloat _ -> "a float"
VBool _ -> "a Boolean"
VNull -> "null"
VStr _ _ -> "a string"
VPath _ -> "a path"
VList _ -> "a list"
VAttrs _ -> "a set"
VLambda {} -> "a function"
VDerivation _ -> "a derivation"
VBuiltin _ _ -> "a built-in function"
VCompiledRegex _ -> "a built-in function"
-- ---------------------------------------------------------------------------
-- Evaluation monad
-- ---------------------------------------------------------------------------
-- | Effect class for Nix evaluation. Core logic is polymorphic in @m@
-- so the same evaluator composes into 'PureEval' for tests or @IO@ for
-- real file-system access (e.g. @import@, @readFile@).
class (Monad m) => MonadEval m where
-- | Raise an evaluation error (type error, missing attribute, IO
-- failure). NOT caught by @builtins.tryEval@: upstream Nix catches only
-- ThrownError\/AssertionError there, and every other EvalError escapes.
throwEvalError :: Text -> m a
-- | Raise a catchable error - @builtins.throw@ and a failed @assert@.
-- These are the only errors 'catchEvalError' (tryEval) recovers from.
throwCatchableError :: Text -> m a
-- | Abort evaluation (uncatchable by tryEval, matching real Nix).
abortEvaluation :: Text -> m a
-- | tryEval semantics: recover from a 'throwCatchableError'
-- (throw\/assert); eval errors and aborts propagate.
catchEvalError :: m a -> m (Either Text a)
-- | Run the action; when it fails with ANY evaluation failure
-- (catchable throw, eval error, or abort), run the cleanup and let
-- the failure propagate unchanged. The error half of a bracket -
-- success runs no cleanup - for builtins that hold external state
-- (a scratch directory) across throwing calls. 'catchEvalError'
-- cannot express this: it recovers only catchable throws, and a
-- failed fetch is an eval error.
onEvalError :: m a -> m () -> m a
doesPathExist :: Text -> m Bool
-- | List a directory, returning @(name, fileType)@ pairs.
-- @fileType@ is one of @"regular"@, @"directory"@, or @"symlink"@
-- (matching Nix's @builtins.readDir@ semantics).
listDirectory :: Text -> m [(Text, Text)]
importFile :: Text -> m NixValue
-- | Look up an environment variable. Returns @""@ if unset.
getEnvVar :: Text -> m Text
-- | Get the current epoch time (seconds since 1970-01-01).
getCurrentTime :: m Int64
-- | Write a named file to the store at upstream's text-path
-- (@text:\<refs\>@ scheme, flat sha256 of the contents), returning the
-- canonical store path. The contents are raw bytes (a Nix string's
-- payload) - hashed and stored exactly as given. The refs are the
-- contents' plain store-path references; they participate in the path
-- computation exactly as upstream's addTextToStore.
writeToStore :: Text -> ByteString -> [StorePath] -> m Text
-- | Import a file with a custom scope overlaid on builtins.
scopedImportFile :: [(Text, Thunk)] -> Text -> m NixValue
-- | Read raw bytes from a file. Used by @builtins.hashFile@.
readFileBytes :: Text -> m ByteString
-- | Classify a single filesystem path as @"regular"@, @"directory"@,
-- @"symlink"@, or @"unknown"@. Used by @builtins.readFileType@.
getFileType :: Text -> m Text
-- | Run an external process: @(command, args, stdin) -> (exitCode, stdout, stderr)@.
runProcess :: Text -> [Text] -> Text -> m (Int, Text, Text)
-- | Create a fetcher scratch directory under the system temp dir: the
-- given name prefix plus an unpredictable suffix, exclusively created.
-- A fixed scratch name in the shared temp dir gives any other local
-- process a pre-place\/swap window between creation and the store
-- copy, so the name must be unguessable and creation must fail rather
-- than adopt an existing directory.
createScratchDir :: Text -> m Text
-- | Recursively remove a directory 'createScratchDir' created.
removeScratchDir :: Text -> m ()
-- | Resolve a path literal to a canonical path.
-- In IO evaluation, @~/@ resolves against the home directory and other
-- relative paths resolve against the current file's directory
-- (@esBaseDir@); this ensures that path values captured in closures
-- remain valid after the import scope ends. In pure evaluation the
-- text is not absolutized. Every implementation ends with lexical
-- canonicalization ('Nix.Eval.CanonPath.canonPath'), as upstream: no
-- dot segment or repeated separator survives into a path value.
resolvePathLiteral :: Text -> m Text
-- | Copy a path (file or directory) to the store, returning the store
-- path. Content-addressed like upstream addToStore: recursive NAR
-- sha256 under the given name. Arguments: source path, store name,
-- and an optional sha256 pin as (error subject, expected digest): a
-- digest mismatch fails the copy with the subject heading the message.
-- @builtins.path@ and @builtins.fetchTarball@ share this pin.
copyPathToStore :: Text -> Text -> Maybe (Text, ByteString) -> m Text
-- | Recursive NAR sha256 digest of a path, without copying it anywhere.
-- Used by @builtins.fetchGit@ to report @narHash@.
narHashOfPath :: Text -> m ByteString
-- | Whether a regular file carries the executable bit (NAR encodes it).
isExecutableFile :: Text -> m Bool
-- | Mark a regular file executable (mode bit on Unix, an alternate data
-- stream on Windows). Run before the tree is copied to the store.
setExecutableFile :: Text -> m ()
-- | Look up a previously recorded fetch by a key naming exactly what was
-- fetched. 'Nothing' when nothing was recorded, or the record no longer
-- describes anything on disk.
lookupFetchCache :: Text -> m (Maybe Text)
-- | Take over a store path an earlier evaluation wrote: 'True' when it is
-- still on disk, and recorded as this evaluation's own store write in
-- that case. Reusing a path instead of rewriting it must still leave the
-- registration behind, or the build driver never registers it and a
-- derivation naming it fails with \"references unregistered path\".
adoptStorePath :: Text -> m Bool
-- | Record a fetch under that key. Failing to record is not an error -
-- the cache is an optimisation.
writeFetchCache :: Text -> Text -> m ()
-- | Read a symlink's target WITHOUT following it.
readSymlinkTarget :: Text -> m Text
-- | Unpack a serialized NAR into the store under the given name at its
-- canonical recursive fixed-output path (sha256 of the bytes),
-- returning the store path text. Used by @builtins.path@ and
-- @builtins.filterSource@ with a filter, whose filtered tree exists
-- only as a NAR value and never on the source filesystem.
addSourceNar :: Text -> ByteString -> m Text
-- | Write raw bytes to the store at a canonical flat fixed-output path
-- (@makeFixedOutputPath name "sha256" "flat"@), so a hash-pinned fetch lands
-- at the same store path C++ Nix computes - reproducible and cacheable.
addFixedOutputFile :: Text -> ByteString -> m Text
-- | Print a trace/warning message.
-- IO evaluators write to stderr; pure evaluators silently discard.
traceMessage :: Text -> m ()
-- | Force a thunk to a value, with memoization.
-- IO evaluators should cache results (via per-thunk @IORef@).
-- Pure evaluators re-evaluate each time.
-- The first argument is the bytecode evaluation function (to break
-- the Eval.Types to Eval circular dependency).
forceThunk :: (Env -> Word32 -> m NixValue) -> Thunk -> m NixValue
-- | Look up a cached derivation modulo-hash (hex) by its @.drv@ store
-- path. Populated bottom-up as each derivation is computed; used by the
-- derivation-hash algorithm to substitute input derivations. Pure
-- evaluators have no cache and always return 'Nothing'.
lookupDrvHash :: Text -> m (Maybe Text)
-- | Cache a derivation's modulo hash (hex) under its @.drv@ store path.
-- A no-op in pure evaluators (no memoization).
cacheDrvHash :: Text -> Text -> m ()
-- | Record a derivation's serialized @.drv@ ATerm (the exact bytes whose
-- hash is its store path) under its @.drv@ store path, as each derivation
-- is computed (bottom-up). Unlike 'cacheDrvHash' (which stores only the
-- modulo hash), this retains the full ATerm so the build driver can
-- materialize the entire input-@.drv@ closure to the store before a
-- dependency-aware build. A no-op in pure evaluators.
recordDrvAterm :: Text -> ByteString -> m ()
-- | Read and parse a derivation from its @.drv@ in the store, or 'Nothing'
-- if it is absent or unreadable. Used to resolve an input derivation's
-- modulo hash on a cache miss - a cross-session reference, or a path
-- fabricated by @builtins.appendContext@ - where the referenced derivation
-- was not evaluated this session. Reading the store is an effect, so this
-- is an IO-evaluator capability: pure evaluators return 'Nothing', which
-- makes hashing a dependent derivation something only the IO evaluator can do.
readStoreDerivation :: StorePath -> m (Maybe Derivation)
-- | Look up a derivation evaluated earlier THIS session by its @.drv@ store
-- path, or 'Nothing' if it was not. The IO evaluator reads the ATerm it
-- recorded bottom-up ('recordDrvAterm'); pure evaluators return 'Nothing'.
-- Used to recover a referenced derivation's output names for an all-outputs
-- (DrvDeep) context reference without a disk read - the in-session @.drv@ is
-- not on disk during evaluation.
lookupSessionDrv :: Text -> m (Maybe Derivation)
-- | Compute the store path a source file/directory gets when copied into
-- the store (recursive NAR sha256 to a @source@ fixed-output path), WITHOUT
-- performing the copy. Used when a path literal is coerced in a derivation
-- argument or environment value. Unavailable in pure evaluation.
storeSourcePath :: Text -> m Text
-- | Unwrap a store-path construction result (the @makeStorePath@ family
-- in "Nix.Hash"), converting a rejected name into an eval error under
-- the given context prefix (e.g. @builtins.toFile@). Every eval-side
-- path construction goes through this or a bespoke equivalent, so a
-- name rejection always surfaces as a clean eval error rather than an
-- unchecked write path.
storePathOrThrow :: (MonadEval m) => Text -> Either StorePathNameError StorePath -> m StorePath
storePathOrThrow context =
either (throwEvalError . ((context <> ": ") <>) . storePathNameErrorText) pure
-- | Error raised during pure evaluation. 'PThrow' (@builtins.throw@, a
-- failed @assert@) is the only kind 'tryEval' catches; 'PError' (type
-- errors, missing attributes) and 'PAbort' (@abort@, infinite recursion)
-- escape it, exactly as in C++ Nix.
data PureError = PThrow !Text | PError !Text | PAbort !Text
-- | Pure evaluation monad - wraps @Either PureError@.
-- IO builtins ('readFile', 'import') are unavailable;
-- everything else evaluates identically to the IO version.
newtype PureEval a = PureEval (Either PureError a)
deriving (Functor, Applicative, Monad)
-- | Run a pure evaluation, flattening the internal error into 'Text'. An abort
-- is prefixed @\"evaluation aborted: \"@, matching 'EvalIO'.
runPureEval :: PureEval a -> Either Text a
runPureEval (PureEval (Right a)) = Right a
runPureEval (PureEval (Left (PThrow t))) = Left t
runPureEval (PureEval (Left (PError t))) = Left t
runPureEval (PureEval (Left (PAbort t))) = Left ("evaluation aborted: " <> t)
instance MonadEval PureEval where
throwEvalError msg = PureEval (Left (PError msg))
throwCatchableError msg = PureEval (Left (PThrow msg))
abortEvaluation msg = PureEval (Left (PAbort msg))
-- Catch only a throw/assert (tryEval sees the error); eval errors,
-- aborts, and infinite recursion propagate, matching EvalIO and C++ Nix.
catchEvalError (PureEval action) =
PureEval $ case action of
Left (PThrow t) -> Right (Left t)
Left other -> Left other
Right a -> Right (Right a)
-- Pure evaluation has no external state, so there is nothing to
-- clean up; the failure passes through unchanged.
onEvalError (PureEval action) _ = PureEval action
doesPathExist _ = pure False
listDirectory _ = throwEvalError "builtins.readDir: not available in pure evaluation"
importFile _ = throwEvalError "import: not available in pure evaluation"
getEnvVar _ = pure ""
getCurrentTime = pure 0
writeToStore _ _ _ = throwEvalError "toFile: not available in pure evaluation"
scopedImportFile _ _ = throwEvalError "scopedImport: not available in pure evaluation"
readFileBytes _ = throwEvalError "readFile: not available in pure evaluation"
getFileType _ = throwEvalError "readFileType: not available in pure evaluation"
runProcess _ _ _ = throwEvalError "runProcess: not available in pure evaluation"
createScratchDir _ = throwEvalError "createScratchDir: not available in pure evaluation"
removeScratchDir _ = pure ()
copyPathToStore _ _ _ = throwEvalError "builtins.path: not available in pure evaluation"
narHashOfPath _ = throwEvalError "builtins.fetchGit: not available in pure evaluation"
isExecutableFile _ = throwEvalError "builtins.path: not available in pure evaluation"
setExecutableFile _ = throwEvalError "builtins.fetchGit: not available in pure evaluation"
lookupFetchCache _ = pure Nothing
adoptStorePath _ = pure False
writeFetchCache _ _ = pure ()
readSymlinkTarget _ = throwEvalError "builtins.path: not available in pure evaluation"
addSourceNar _ _ = throwEvalError "builtins.path: not available in pure evaluation"
addFixedOutputFile _ _ = throwEvalError "builtins.fetchurl: not available in pure evaluation"
traceMessage _ = pure ()
lookupDrvHash _ = pure Nothing
cacheDrvHash _ _ = pure ()
recordDrvAterm _ _ = pure ()
-- Pure eval cannot read the store, so a dependent derivation's input hash
-- is never recoverable here; the caller turns this into a loud error rather
-- than a guessed hash.
readStoreDerivation _ = pure Nothing
-- Pure eval keeps no session drv closure, so an all-outputs reference's
-- output names are never recoverable here either.
lookupSessionDrv _ = pure Nothing
-- Pure eval cannot read files: a path coerces to itself (no store copy);
-- the real copy-to-store happens only under 'EvalIO'.
storeSourcePath = pure
resolvePathLiteral = pure . canonPathValue
forceThunk evalFn (Thunk ptr) =
-- Read the C thunk via unsafePerformIO - safe because reads are
-- idempotent and PureEval never writes back (no memoization).
-- Does NOT mark blackholes - PureEval may re-force the same thunk.
-- Dispatches on val_tag for computed scalars (no StablePtr deref).
case unsafePerformIO (cthunkState ptr) of
ThunkComputed ->
let tag = unsafePerformIO (cthunkValueTag ptr)
in case tag of
ValueInt -> pure (VInt (unsafePerformIO (cthunkGetInt ptr)))
ValueFloat -> pure (VFloat (unsafePerformIO (cthunkGetFloat ptr)))
ValueBool -> pure (VBool (unsafePerformIO (cthunkGetBool ptr) /= 0))
ValueNull -> pure VNull
ValueStr ->
let sym = unsafePerformIO (cthunkGetStr ptr)
in pure (VStr (symbolBytes (Symbol sym)) emptyContext)
ValuePath ->
let sym = unsafePerformIO (cthunkGetPath ptr)
in pure (VPath (symbolText (Symbol sym)))
ValueList ->
let listPtr = unsafePerformIO (cthunkGetList ptr)
in pure (VList (CList (castPtr listPtr)))
ValueAttrs ->
let p = unsafePerformIO (cthunkGetAttrs ptr)
in pure (VAttrs (AttrSet (castPtr p)))
ValueCtxStr ->
let csptr = unsafePerformIO (cthunkGetCtxStr ptr)
(t, ctx) = unsafePerformIO (unmarshalStringContext (castPtr csptr))
in pure (VStr t ctx)
ValueLambda ->
let lamRaw = unsafePerformIO (cthunkPayload ptr)
val = unsafePerformIO (unmarshalLambdaValue lamRaw)
in pure val
_ {- PTR -} ->
let payload = unsafePerformIO (cthunkPayload ptr)
val = unsafePerformIO (deRefStablePtr (castPtrToStablePtr payload))
in pure val
ThunkBlackhole ->
-- Non-catchable: must escape tryEval like in C++ Nix
abortEvaluation "infinite recursion encountered"
_ {- PENDING -} ->
let bcIdx = unsafePerformIO (cthunkGetBcIdx ptr)
envSp = unsafePerformIO (cthunkPayload ptr)
env = unsafePerformIO (deRefStablePtr (castPtrToStablePtr envSp))
in evalFn env bcIdx