Implement __curPos as a primitive action during evaluation

src/Nix/Builtins.hs

@@ -21,7 +21,6 @@ import           Control.Monad
 import           Control.Monad.Catch
 import           Control.Monad.Fix
 import           Control.Monad.ListM (sortByM)
-import           Control.Monad.Reader
 import qualified Crypto.Hash.MD5 as MD5
 import qualified Crypto.Hash.SHA1 as SHA1
 import qualified Crypto.Hash.SHA256 as SHA256
@@ -37,7 +36,6 @@ import qualified Data.ByteString.Lazy as LBS
 import           Data.Char (isDigit)
 import           Data.Coerce
 import           Data.Foldable (foldlM)
-import           Data.Functor.Compose
 import           Data.HashMap.Lazy (HashMap)
 import qualified Data.HashMap.Lazy as M
 import qualified Data.HashMap.Strict.InsOrd as OM
@@ -58,7 +56,6 @@ import           Language.Haskell.TH.Syntax (addDependentFile, runIO)
 import           Nix.Atoms
 import           Nix.Eval
 import           Nix.Expr.Types
-import           Nix.Expr.Types.Annotated
 import           Nix.Monad
 import           Nix.Parser
 import           Nix.Pretty
@@ -79,11 +76,7 @@ type MonadBuiltins e m =
 baseEnv :: MonadBuiltins e m => m (Scopes m (NThunk m))
 baseEnv = do
     ref <- thunk $ flip NVSet M.empty <$> builtins
-    let pos = repeatingThunk curPos -- re-evaluate each time it's forced
-    lst <- ([ ("builtins", ref)
-           , ("__curPos", pos)
-           ] ++)
-        <$> topLevelBuiltins
+    lst <- ([("builtins", ref)] ++) <$> topLevelBuiltins
     pushScope (M.fromList lst) currentScopes
   where
     topLevelBuiltins = map mapping . filter isTopLevel <$> builtinsList
@@ -215,29 +208,6 @@ apply f arg = force f $ \f' -> pure f' `evalApp` arg
 
 -- Primops
 
-deltaInfo :: Delta -> (Text, Int, Int)
-deltaInfo = \case
-    Columns c _         -> ("<string>", 1, fromIntegral c + 1)
-    Tab {}              -> ("<string>", 1, 1)
-    Lines l _ _ _       -> ("<string>", fromIntegral l + 1, 1)
-    Directed fn l c _ _ -> (Text.pack fn,
-                           fromIntegral l + 1, fromIntegral c + 1)
-
-posFromDelta :: Delta -> NValue m
-posFromDelta (deltaInfo -> (f, l, c)) =
-    flip NVSet M.empty $ M.fromList
-        [ ("file", valueThunk $ NVStr f mempty)
-        , ("line", valueThunk $ NVConstant (NInt (fromIntegral l)))
-        , ("column", valueThunk $ NVConstant (NInt (fromIntegral c)))
-        ]
-
-curPos :: forall e m. Framed e m => m (NValue m)
-curPos = do
-    Compose (Ann (SrcSpan delta _) _):_ <-
-        asks (mapMaybe (either (const Nothing) Just)
-              . view @_ @Frames hasLens)
-    return $ posFromDelta delta
-
 toString :: MonadBuiltins e m => NThunk m -> m (NValue m)
 toString str = do
     (s, d) <- force str $ normalForm >=> valueText False

src/Nix/Eval.hs

@@ -24,7 +24,8 @@ import           Control.Monad.Fix
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Class
 import           Control.Monad.Trans.Except
-import           Control.Monad.Trans.Reader
+import           Control.Monad.Reader (asks)
+import           Control.Monad.Trans.Reader hiding (asks)
 import           Data.Align
 import           Data.Align.Key
 import           Data.Coerce
@@ -34,7 +35,7 @@ import           Data.HashMap.Lazy (HashMap)
 import qualified Data.HashMap.Lazy as M
 import           Data.HashMap.Strict.InsOrd (toHashMap)
 import           Data.List (intercalate, partition, foldl')
-import           Data.Maybe (fromMaybe, catMaybes)
+import           Data.Maybe (fromMaybe, catMaybes, mapMaybe)
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import           Data.These
@@ -65,6 +66,12 @@ evalExpr = cata eval
 eval :: forall e m. (MonadEval e m, MonadFix m, MonadNix m)
      => NExprF (m (NValue m)) -> m (NValue m)
 
+eval (NSym "__curPos") = do
+    Compose (Ann (SrcSpan delta _) _):_ <-
+        asks (mapMaybe (either (const Nothing) Just)
+              . view @_ @Frames hasLens)
+    return $ posFromDelta delta
+
 eval (NSym var) = do
     traceM $ "NSym: var = " ++ show var
     mres <- lookupVar var

src/Nix/Expr/Types/Annotated.hs

@@ -23,6 +23,7 @@ import Data.Fix
 import Data.Function (on)
 import Data.Functor.Compose
 import Data.Semigroup
+import Data.Text (Text, pack)
 import GHC.Generics
 import Nix.Expr.Types
 import Nix.Parser.Library (Delta(..))
@@ -98,3 +99,10 @@ nAbs _ _ = error "nAbs: unexpected"
 
 nStr :: Ann SrcSpan (NString NExprLoc) -> NExprLoc
 nStr (Ann s1 s) = AnnE s1 (NStr s)
+
+deltaInfo :: Delta -> (Text, Int, Int)
+deltaInfo = \case
+    Columns c _         -> ("<string>", 1, fromIntegral c + 1)
+    Tab {}              -> ("<string>", 1, 1)
+    Lines l _ _ _       -> ("<string>", fromIntegral l + 1, 1)
+    Directed fn l c _ _ -> (pack fn, fromIntegral l + 1, fromIntegral c + 1)

src/Nix/Thunk.hs

@@ -19,15 +19,11 @@ class Monad m => MonadVar m where
 
 data Thunk m v
     = Value v
-    | Action (m v)
     | Thunk (Var m Bool) (Var m (Deferred m v))
 
 valueRef :: v -> Thunk m v
 valueRef = Value
 
-buildRepeatingThunk :: m v -> Thunk m v
-buildRepeatingThunk = Action
-
 buildThunk :: MonadVar m => m v -> m (Thunk m v)
 buildThunk action =
     Thunk <$> newVar False <*> newVar (Deferred action)
@@ -35,7 +31,6 @@ buildThunk action =
 forceThunk :: (Framed e m, MonadFile m, MonadVar m)
            => Thunk m v -> (v -> m r) -> m r
 forceThunk (Value ref) k = k ref
-forceThunk (Action ref) k = k =<< ref
 forceThunk (Thunk active ref) k = do
     eres <- readVar ref
     case eres of
@@ -53,7 +48,6 @@ forceThunk (Thunk active ref) k = do
 forceEffects :: (Framed e m, MonadFile m, MonadVar m)
              => Thunk m v -> (v -> m r) -> m r
 forceEffects (Value ref) k = k ref
-forceEffects (Action ref) k = k =<< ref
 forceEffects (Thunk active ref) k = do
     nowActive <- atomicModifyVar active (True,)
     if nowActive

src/Nix/Value.hs

@@ -3,22 +3,26 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Nix.Value where
 
 import           Data.Coerce
 import           Data.Fix
 import           Data.HashMap.Lazy (HashMap)
+import qualified Data.HashMap.Lazy as M
 import           Data.Monoid (appEndo)
 import           Data.Text (Text)
 import           Data.Typeable (Typeable)
 import           GHC.Generics
 import           Nix.Atoms
 import           Nix.Expr.Types
+import           Nix.Expr.Types.Annotated (deltaInfo)
 import           Nix.Parser.Library (Delta(..))
 import           Nix.Scope
 import           Nix.Thunk
@@ -30,9 +34,6 @@ newtype NThunk m = NThunk (Thunk m (NValue m))
 thunk :: MonadVar m => m (NValue m) -> m (NThunk m)
 thunk = fmap coerce . buildThunk
 
-repeatingThunk :: MonadVar m => m (NValue m) -> NThunk m
-repeatingThunk = coerce . buildRepeatingThunk
-
 force :: (Framed e m, MonadFile m, MonadVar m)
       => NThunk m -> (NValue m -> m r) -> m r
 force = forceThunk . coerce
@@ -119,3 +120,11 @@ builtin3 :: Monad m
          -> m (NValue m)
 builtin3 name f =
     builtin name $ \a -> builtin name $ \b -> builtin name $ \c -> f a b c
+
+posFromDelta :: Delta -> NValue m
+posFromDelta (deltaInfo -> (f, l, c)) =
+    flip NVSet M.empty $ M.fromList
+        [ ("file", valueThunk $ NVStr f mempty)
+        , ("line", valueThunk $ NVConstant (NInt (fromIntegral l)))
+        , ("column", valueThunk $ NVConstant (NInt (fromIntegral c)))
+        ]