diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index a2552f12a..97da9cfa3 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -187,7 +187,7 @@ foldNixPath -> m r foldNixPath z f = do - mres <- lookupVar "__includes" + mres <- lookupVar Unknown "__includes" dirs <- maybe stub @@ -1334,7 +1334,7 @@ scopedImportNix asetArg pathArg = traceM $ "Current file being evaluated is: " <> show p' pure $ takeDirectory p' path ) - =<< lookupVar "__cur_file" + =<< lookupVar Unknown "__cur_file" clearScopes @(NValue t f m) $ withNixContext (pure path') @@ -1544,7 +1544,7 @@ placeHolderNix p = body = ignoreContext readFileNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) -readFileNix = toValue <=< Nix.Render.readFile <=< absolutePathFromValue <=< demand +readFileNix = toValue <=< Nix.Render.readFile . coerce . toString . ignoreContext <=< fromValue @NixString findFileNix :: forall e t f m @@ -2080,8 +2080,8 @@ withNixContext mpath action = base <- builtins opts <- askOptions - pushScope - (one ("__includes", NVList $ mkNVStrWithoutContext . fromString . coerce <$> getInclude opts)) + pushWeakScope + (pure $ one ("__includes", NVList $ mkNVStrWithoutContext . fromString . coerce <$> getInclude opts)) (pushScopes base $ maybe @@ -2089,7 +2089,7 @@ withNixContext mpath action = (\ path act -> do traceM $ "Setting __cur_file = " <> show path - pushScope (one ("__cur_file", NVPath path)) act + pushWeakScope (pure $ one ("__cur_file", NVPath path)) act ) mpath action @@ -2104,7 +2104,7 @@ builtins builtins = do ref <- defer $ NVSet mempty <$> buildMap - (`pushScope` askScopes) . coerce . M.fromList . (one ("builtins", ref) <>) =<< topLevelBuiltins + (`pushWeakScope` askScopes) . pure . coerce . M.fromList . (one ("builtins", ref) <>) =<< topLevelBuiltins where buildMap :: m (HashMap VarName (NValue t f m)) buildMap = M.fromList . (mapping <$>) <$> builtinsList diff --git a/src/Nix/Effects/Basic.hs b/src/Nix/Effects/Basic.hs index d5e98ca0a..ed2ddbf74 100644 --- a/src/Nix/Effects/Basic.hs +++ b/src/Nix/Effects/Basic.hs @@ -51,7 +51,7 @@ defaultToAbsolutePath origPath = val -> throwError $ ErrorCall $ "when resolving relative path, __cur_file is in scope, but is not a path; it is: " <> show val ) <=< demand ) - =<< lookupVar "__cur_file" + =<< lookupVar Unknown "__cur_file" ) (pure origPathExpanded) (isAbsolute origPathExpanded) @@ -94,7 +94,7 @@ findEnvPathM name = l <- fromValue @[NValue t f m] =<< demand v findPathBy nixFilePath l name ) - =<< lookupVar "__nixPath" + =<< lookupVar Unknown "__nixPath" where nixFilePath :: MonadEffects t f m => Path -> m (Maybe Path) diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs index 7e90a0d39..dfeac1827 100644 --- a/src/Nix/Eval.hs +++ b/src/Nix/Eval.hs @@ -103,11 +103,11 @@ instance (Typeable m, Typeable v) => Exception (SynHoleInfo m v) -- eval :: forall v m . MonadNixEval v m => NExprF v -> m v eval :: forall v m . MonadNixEval v m => NExprF (m v) -> m v -eval (NSym "__curPos") = evalCurPos +eval (NSym _ "__curPos") = evalCurPos -eval (NSym var ) = +eval (NSym offset var ) = do - mVal <- lookupVar var + mVal <- lookupVar offset var maybe (freeVariable var) (evaledSym var <=< demand) @@ -396,12 +396,12 @@ evalBinds isRecursive binds = (attrMissing (one var) Nothing) demand =<< maybe - (withScopes scopes $ lookupVar var) + (withScopes scopes $ lookupVar Unknown var) (\ s -> do (coerce -> scope, _) <- fromValue @(AttrSet v, PositionSet) =<< s - clearScopes $ pushScope @v scope $ lookupVar var + clearScopes $ pushScope @v scope $ lookupVar Unknown var ) ms ) diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs index 93dae2d08..0b7172bcc 100644 --- a/src/Nix/Exec.hs +++ b/src/Nix/Exec.hs @@ -159,7 +159,7 @@ askSpan :: forall e m . (MonadReader e m, Has e SrcSpan) => m SrcSpan askSpan = askLocal wrapExprLoc :: SrcSpan -> NExprLocF r -> NExprLoc -wrapExprLoc span x = Fix $ NSymAnn span "" <$ x +wrapExprLoc span x = Fix $ NSymAnn span Unknown "" <$ x {-# inline wrapExprLoc #-} -- 2021-01-07: NOTE: This instance belongs to be beside MonadEval type class. @@ -193,7 +193,7 @@ instance MonadNix e t f m => MonadEval (NValue t f m) m where scope <- askScopes span@(SrcSpan delta _) <- askSpan addProvenance @_ @_ @(NValue t f m) - (Provenance scope . NSymAnnF span $ coerce @Text "__curPos") <$> + (Provenance scope . NSymAnnF span Unknown $ coerce @Text "__curPos") <$> toValue delta evaledSym name val = @@ -202,7 +202,7 @@ instance MonadNix e t f m => MonadEval (NValue t f m) m where span <- askSpan pure $ addProvenance @_ @_ @(NValue t f m) - (Provenance scope $ NSymAnnF span name) + (Provenance scope $ NSymAnnF span Unknown name) val evalConstant c = @@ -543,7 +543,7 @@ addTracing k v = do let rendered = bool - (prettyNix $ Fix $ Fix (NSym "?") <$ x) + (prettyNix $ Fix $ Fix (NSym Unknown "?") <$ x) (pretty $ PS.ppShow $ void x) (getVerbosity opts >= Chatty) msg x = pretty ("eval: " <> replicate depth ' ') <> x diff --git a/src/Nix/Expr/Shorthands.hs b/src/Nix/Expr/Shorthands.hs index 516b28a40..e3788b6f2 100644 --- a/src/Nix/Expr/Shorthands.hs +++ b/src/Nix/Expr/Shorthands.hs @@ -58,8 +58,8 @@ mkRelPath :: FilePath -> NExpr mkRelPath = Fix . mkRelPathF -- | Put a variable (symbol). -mkSym :: Text -> NExpr -mkSym = Fix . mkSymF +mkSym :: VarOffset -> Text -> NExpr +mkSym offset = Fix . mkSymF offset -- | Put syntactic hole. mkSynHole :: Text -> NExpr @@ -252,8 +252,8 @@ mkRelPathF :: FilePath -> NExprF a mkRelPathF = mkPathF False -- | Unfixed @mkSym@. -mkSymF :: Text -> NExprF a -mkSymF = NSym . coerce +mkSymF :: VarOffset -> Text -> NExprF a +mkSymF offset = NSym offset . coerce -- | Unfixed @mkSynHole@. mkSynHoleF :: Text -> NExprF a diff --git a/src/Nix/Expr/Types.hs b/src/Nix/Expr/Types.hs index 27d9e7c19..78c33f70e 100644 --- a/src/Nix/Expr/Types.hs +++ b/src/Nix/Expr/Types.hs @@ -556,6 +556,34 @@ data NBinaryOp $(makeTraversals ''NBinaryOp) +-- | An offset counts the number of scopes between a variable and the +-- particular scope where it is bound. The displacement can be used to access +-- the right var in that scope. Think de Bruyn indices for nix expressions +-- where each scope can provide many variables. +data StaticOffset = StaticOffset { level :: !Int, displacement :: !Int } + deriving + ( Eq, Ord, Bounded, Generic + , Typeable, Data, NFData, Serialise, Binary, ToJSON, FromJSON + , Show, Read, Hashable + ) + +data VarOffset + = Unknown + -- ^ No binding analysis was ever performed. + -- Easier to allow that than defining variants of this AST. + | Dynamic + -- ^ Dynamic binding, have to look up into all the enclosing `NWith` envs. + | Static {-# UNPACK #-} !StaticOffset + -- ^ Static scope binding, with `level` and `displacement` inside level. + -- Because we know where to look up, it can be faster. + deriving + ( Eq, Ord, Generic + , Typeable, Data, NFData, Serialise, Binary, ToJSON, FromJSON + , Show, Read, Hashable + ) + +$(makeTraversals ''VarOffset) +$(makeTraversals ''StaticOffset) -- * data NExprF - Nix expressions, base functor @@ -568,7 +596,7 @@ data NExprF r -- ^ Constants: ints, floats, bools, URIs, and null. | NStr !(NString r) -- ^ A string, with interpolated expressions. - | NSym !VarName + | NSym !VarOffset !VarName -- ^ A variable. For example, in the expression @f a@, @f@ is represented -- as @NSym "f"@ and @a@ as @NSym "a"@. -- @@ -675,7 +703,7 @@ type NExpr = Fix NExprF -- | We make an `IsString` for expressions, where the string is interpreted -- as an identifier. This is the most common use-case... instance IsString NExpr where - fromString = Fix . NSym . fromString + fromString = Fix . NSym Unknown . fromString instance Serialise NExpr @@ -805,7 +833,7 @@ getFreeVars e = case unFix e of (NConstant _ ) -> mempty (NStr string ) -> mapFreeVars string - (NSym var ) -> one var + (NSym _ var ) -> one var (NList list ) -> mapFreeVars list (NSet NonRecursive bindings) -> bindFreeVars bindings (NSet Recursive bindings) -> diffBetween bindFreeVars bindDefs bindings diff --git a/src/Nix/Expr/Types/Annotated.hs b/src/Nix/Expr/Types/Annotated.hs index 829725682..9baeec304 100644 --- a/src/Nix/Expr/Types/Annotated.hs +++ b/src/Nix/Expr/Types/Annotated.hs @@ -197,8 +197,8 @@ pattern NConstantAnnF ann x = AnnF ann (NConstant x) pattern NStrAnnF :: SrcSpan -> NString r -> NExprLocF r pattern NStrAnnF ann x = AnnF ann (NStr x) -pattern NSymAnnF :: SrcSpan -> VarName -> NExprLocF r -pattern NSymAnnF ann x = AnnF ann (NSym x) +pattern NSymAnnF :: SrcSpan -> VarOffset -> VarName -> NExprLocF r +pattern NSymAnnF ann x y = AnnF ann (NSym x y) pattern NListAnnF :: SrcSpan -> [r] -> NExprLocF r pattern NListAnnF ann x = AnnF ann (NList x) @@ -255,8 +255,8 @@ pattern NConstantAnn ann x = Ann ann (NConstant x) pattern NStrAnn :: SrcSpan -> NString NExprLoc -> NExprLoc pattern NStrAnn ann x = Ann ann (NStr x) -pattern NSymAnn :: SrcSpan -> VarName -> NExprLoc -pattern NSymAnn ann x = Ann ann (NSym x) +pattern NSymAnn :: SrcSpan -> VarOffset -> VarName -> NExprLoc +pattern NSymAnn ann x y = Ann ann (NSym x y) pattern NListAnn :: SrcSpan -> [NExprLoc] -> NExprLoc pattern NListAnn ann x = Ann ann (NList x) diff --git a/src/Nix/Parser.hs b/src/Nix/Parser.hs index 626ead9d8..9e005e4d1 100644 --- a/src/Nix/Parser.hs +++ b/src/Nix/Parser.hs @@ -62,8 +62,8 @@ import Data.Char ( isAlpha , isSpace ) import Data.Data ( Data(..) ) -import Data.List.Extra ( groupSort ) -import Data.Fix ( Fix(..) ) +import Data.List.Extra ( groupSort, findIndex ) +import Data.Fix ( Fix(..), foldFixM ) import qualified Data.HashSet as HashSet import qualified Data.Text as Text import Nix.Expr.Types @@ -363,7 +363,7 @@ identifier = identLetter x = isAlphanumeric x || x == '_' || x == '\'' || x == '-' nixSym :: Parser NExprLoc -nixSym = annotateLocation $ mkSymF <$> coerce identifier +nixSym = annotateLocation $ mkSymF Unknown <$> coerce identifier -- ** ( ) parens @@ -972,7 +972,7 @@ parseFromText :: Parser a -> Text -> Result a parseFromText = (`parseWith` "") fullContent :: Parser NExprLoc -fullContent = whiteSpace *> nixExpr <* eof +fullContent = resolveBindings <$> (whiteSpace *> nixExpr <* eof) parseNixFile' :: MonadFile m => (Parser NExprLoc -> Parser a) -> Path -> m (Result a) parseNixFile' f = @@ -1004,3 +1004,40 @@ parseExpr = (fail . show) pure . parseNixText + +resolveBindings :: NExprLoc -> NExprLoc +resolveBindings = (`runReader` []) . proceed + where + proceed :: NExprLoc -> Reader [[VarName]] NExprLoc + proceed expr = case expr of + NSymAnn ann _ x -> (\offset -> NSymAnn ann offset x) <$> lookupOffset x + NSetAnn ann Recursive bindings -> + let scope = bindDefs bindings + in NSetAnn ann Recursive <$> local (scope:) (mapM (mapM proceed) bindings) + NAbsAnn ann params body -> + let scope = paramDefs params + in NAbsAnn ann <$> local (scope:) (mapM proceed params) <*> local (scope:) (proceed body) + NLetAnn ann bindings body -> + let scope = bindDefs bindings + in NLetAnn ann <$> local (scope:) (mapM (mapM proceed) bindings) <*> local (scope:) (proceed body) + _ -> fmap Fix . mapM proceed . unFix $ expr + + lookupOffset :: VarName -> Reader [[VarName]] VarOffset + lookupOffset name = maybe Dynamic (\lvl -> Static $ StaticOffset lvl 0) . findIndex (elem name) <$> ask + + bindDefs :: [Binding r] -> [VarName] + bindDefs = foldMap bind1Def + where + bind1Def :: Binding r -> [VarName] + bind1Def (Inherit Nothing _ _) = mempty + bind1Def (Inherit (Just _ ) keys _) = toList keys + bind1Def (NamedVar (StaticKey varname :| _) _ _) = one varname + bind1Def (NamedVar (DynamicKey _ :| _) _ _) = mempty + + paramDefs :: Params a -> [VarName] + paramDefs (Param varname) = one varname + paramDefs (ParamSet varname _ pset) = (one `whenJust` varname) <> (fst <$> pset) + + + + diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs index 72ca042d2..ea6016a86 100644 --- a/src/Nix/Pretty.hs +++ b/src/Nix/Pretty.hs @@ -313,7 +313,7 @@ exprFNixDoc = \case ("./" <> path) path (any (`isPrefixOf` coerce path) ["/", "~/", "./", "../"]) - NSym name -> simpleExpr $ prettyVarName name + NSym _ name -> simpleExpr $ prettyVarName name NLet binds body -> leastPrecedence $ group $ @@ -355,7 +355,7 @@ exprFNixDoc = \case valueToExpr :: forall t f m . MonadDataContext f m => NValue t f m -> NExpr valueToExpr = iterNValueByDiscardWith thk (Fix . phi) where - thk = Fix . NSym $ "" + thk = Fix . NSym Unknown $ "" phi :: NValue' t f m NExpr -> NExprF NExpr phi (NVConstant' a ) = NConstant a @@ -365,9 +365,9 @@ valueToExpr = iterNValueByDiscardWith thk (Fix . phi) [ NamedVar (one $ StaticKey k) v (fromMaybe nullPos $ (`M.lookup` p) k) | (k, v) <- toList s ] - phi (NVClosure' _ _) = NSym "" + phi (NVClosure' _ _) = NSym Unknown "" phi (NVPath' p ) = NLiteralPath p - phi (NVBuiltin' name _) = NSym $ coerce ((mappend @Text) "builtins.") name + phi (NVBuiltin' name _) = NSym Unknown $ coerce ((mappend @Text) "builtins.") name prettyNValue :: forall t f m ann . MonadDataContext f m => NValue t f m -> Doc ann diff --git a/src/Nix/Reduce.hs b/src/Nix/Reduce.hs index 2a9ffd2a3..b0b2ccee3 100644 --- a/src/Nix/Reduce.hs +++ b/src/Nix/Reduce.hs @@ -152,8 +152,8 @@ reduce -- | Reduce the variable to its value if defined. -- Leave it as it is otherwise. -reduce (NSymAnnF ann var) = - fromMaybe (NSymAnn ann var) <$> lookupVar var +reduce (NSymAnnF ann offset var) = + fromMaybe (NSymAnn ann offset var) <$> lookupVar offset var -- | Reduce binary and integer negation. reduce (NUnaryAnnF uann op arg) = @@ -173,7 +173,7 @@ reduce (NUnaryAnnF uann op arg) = -- scope and recursively reducing its body. reduce (NAppAnnF bann fun arg) = (\case - f@(NSymAnn _ "import") -> + f@(NSymAnn _ _ "import") -> (\case -- NEnvPathAnn pann origPath -> staticImport pann origPath NLiteralPathAnn pann origPath -> staticImport pann origPath @@ -325,9 +325,9 @@ reduce (NAbsAnnF ann params body) = do let scope = coerce $ case params' of - Param name -> one (name, NSymAnn ann name) + Param name -> one (name, NSymAnn ann Unknown name) ParamSet _ _ pset -> - HM.fromList $ (\(k, _) -> (k, NSymAnn ann k)) <$> pset + HM.fromList $ (\(k, _) -> (k, NSymAnn ann Unknown k)) <$> pset NAbsAnn ann params' <$> pushScope scope body reduce v = reduceLayer v diff --git a/src/Nix/Render/Frame.hs b/src/Nix/Render/Frame.hs index 175b71378..396b87fa6 100644 --- a/src/Nix/Render/Frame.hs +++ b/src/Nix/Render/Frame.hs @@ -97,7 +97,7 @@ renderFrame (NixFrame level f) | otherwise = fail $ "Unrecognized frame: " <> show f wrapExpr :: NExprF r -> NExpr -wrapExpr x = Fix (Fix (NSym "") <$ x) +wrapExpr x = Fix (Fix (NSym Unknown "") <$ x) renderEvalFrame :: forall e m v ann @@ -164,7 +164,7 @@ renderExpr _level longLabel shortLabel e@(Ann _ x) = expr :: NExpr expr = stripAnnotation e - concise = prettyNix $ Fix $ Fix (NSym "") <$ x + concise = prettyNix $ Fix $ Fix (NSym Unknown "") <$ x chatty = bool diff --git a/src/Nix/Scope.hs b/src/Nix/Scope.hs index 536933330..ffd8075d9 100644 --- a/src/Nix/Scope.hs +++ b/src/Nix/Scope.hs @@ -58,7 +58,7 @@ class Scoped a m | m -> a where askScopes :: m (Scopes m a) clearScopes :: m r -> m r pushScopes :: Scopes m a -> m r -> m r - lookupVar :: VarName -> m (Maybe a) + lookupVar :: VarOffset -> VarName -> m (Maybe a) askScopesReader :: forall m a e @@ -107,31 +107,35 @@ lookupVarReader . ( MonadReader e m , Has e (Scopes m a) ) - => VarName + => VarOffset + -> VarName -> m (Maybe a) -lookupVarReader k = - do +lookupVarReader offset k = case offset of + Static (StaticOffset lvl _) -> do + mres <- asks $ M.lookup k . unscope <=< (!!? lvl) . lexicalScopes @m . view hasLens + maybe (error "binding analysis error") (pure . Just) mres + Dynamic -> dynamicLookup + Unknown -> do mres <- asks $ scopeLookup k . lexicalScopes @m . view hasLens - - maybe - (do - ws <- asks $ dynamicScopes . view hasLens - - foldr - (\ weakscope rest -> - do - mres' <- M.lookup k . coerce @(Scope a) <$> weakscope - - maybe - rest - (pure . pure) - mres' - ) - (pure Nothing) - ws - ) - (pure . pure) - mres + maybe dynamicLookup (pure . Just) mres + where + unscope (Scope s) = s + dynamicLookup = + do + ws <- asks $ dynamicScopes . view hasLens + + foldr + (\ weakscope rest -> + do + mres' <- M.lookup k . coerce @(Scope a) <$> weakscope + + maybe + rest + (pure . pure) + mres' + ) + (pure Nothing) + ws withScopes :: Scoped a m diff --git a/src/Nix/TH.hs b/src/Nix/TH.hs index 5dc9a290c..1b5743f73 100644 --- a/src/Nix/TH.hs +++ b/src/Nix/TH.hs @@ -54,7 +54,7 @@ instance ToExpr NExprLoc where toExpr = id instance ToExpr VarName where - toExpr = NSymAnn nullSpan + toExpr = NSymAnn nullSpan Unknown instance ToExpr Int where toExpr = NConstantAnn nullSpan . NInt . fromIntegral @@ -66,12 +66,12 @@ instance ToExpr Float where toExpr = NConstantAnn nullSpan . NFloat metaExp :: Set VarName -> NExprLoc -> Maybe ExpQ -metaExp fvs (NSymAnn _ x) | x `Set.member` fvs = +metaExp fvs (NSymAnn _ _ x) | x `Set.member` fvs = pure [| toExpr $(varE (mkName $ toString x)) |] metaExp _ _ = Nothing metaPat :: Set VarName -> NExprLoc -> Maybe PatQ -metaPat fvs (NSymAnn _ x) | x `Set.member` fvs = +metaPat fvs (NSymAnn _ _ x) | x `Set.member` fvs = pure $ varP $ mkName $ toString x metaPat _ _ = Nothing