diff --git a/src/Juvix/Compiler/Nockma/Evaluator.hs b/src/Juvix/Compiler/Nockma/Evaluator.hs index fd5d39e3c6..a3d3d14bf6 100644 --- a/src/Juvix/Compiler/Nockma/Evaluator.hs +++ b/src/Juvix/Compiler/Nockma/Evaluator.hs @@ -87,17 +87,17 @@ subTermT = go L -> (\l' -> TermCell (set cellLeft l' c)) <$> go ds g (c ^. cellLeft) R -> (\r' -> TermCell (set cellRight r' c)) <$> go ds g (c ^. cellRight) -subTerm :: (Members '[Reader EvalCtx, Error (NockEvalError a)] r) => Term a -> Path -> Sem r (Term a) -subTerm term pos = +subTerm :: (Members '[Reader EvalCtx, Error (NockEvalError a)] r) => Term a -> Path -> Maybe Interval -> Sem r (Term a) +subTerm term pos posLoc = case term ^? subTermT pos of - Nothing -> throwInvalidPath term pos + Nothing -> throwInvalidPath posLoc term pos Just t -> return t setSubTerm :: forall a r. (Members '[Error (NockEvalError a), Reader EvalCtx] r) => Term a -> Path -> Term a -> Sem r (Term a) setSubTerm term pos repTerm = let (old, new) = setAndRemember (subTermT' pos) repTerm term in if - | isNothing (getFirst old) -> throwInvalidPath term pos + | isNothing (getFirst old) -> throwInvalidPath Nothing term pos | otherwise -> return new parseCell :: @@ -435,7 +435,7 @@ evalProfile inistack initerm = goOpAddress :: Sem r (Term a) goOpAddress = do cr <- withCrumb (crumb crumbDecodeFirst) (asPath (c ^. operatorCellTerm)) - withCrumb (crumb crumbEval) (subTerm stack cr) + withCrumb (crumb crumbEval) (subTerm stack cr (c ^. operatorCellTerm . termLoc)) goOpQuote :: Term a goOpQuote = c ^. operatorCellTerm @@ -517,7 +517,7 @@ evalProfile inistack initerm = cellTerm <- withCrumb (crumb crumbDecodeFirst) (asCell (c ^. operatorCellTerm)) r <- withCrumb (crumb crumbDecodeSecond) (asPath (cellTerm ^. cellLeft)) t' <- evalArg crumbEvalFirst stack (cellTerm ^. cellRight) - subTerm t' r >>= evalArg crumbEvalSecond t' + subTerm t' r (cellTerm ^. cellLeft . termLoc) >>= evalArg crumbEvalSecond t' goOpSequence :: Sem r (Term a) goOpSequence = do diff --git a/src/Juvix/Compiler/Nockma/Evaluator/Error.hs b/src/Juvix/Compiler/Nockma/Evaluator/Error.hs index 1f76d64566..c46c908550 100644 --- a/src/Juvix/Compiler/Nockma/Evaluator/Error.hs +++ b/src/Juvix/Compiler/Nockma/Evaluator/Error.hs @@ -39,7 +39,8 @@ data ExpectedAtom a = ExpectedAtom data InvalidPath a = InvalidPath { _invalidPathCtx :: EvalCtx, _invalidPathTerm :: Term a, - _invalidPathPath :: Path + _invalidPathPath :: Path, + _invalidPathLocation :: Maybe Interval } data KeyNotInStorage a = KeyNotInStorage @@ -76,15 +77,16 @@ throwInvalidNockOp a = do _invalidNockOp = a } -throwInvalidPath :: (Members '[Error (NockEvalError a), Reader EvalCtx] r) => Term a -> Path -> Sem r x -throwInvalidPath tm p = do +throwInvalidPath :: (Members '[Error (NockEvalError a), Reader EvalCtx] r) => Maybe Interval -> Term a -> Path -> Sem r x +throwInvalidPath mi tm p = do ctx <- ask throw $ ErrInvalidPath InvalidPath { _invalidPathCtx = ctx, _invalidPathTerm = tm, - _invalidPathPath = p + _invalidPathPath = p, + _invalidPathLocation = mi } throwExpectedCell :: (Members '[Error (NockEvalError a), Reader EvalCtx] r) => Atom a -> Sem r x @@ -147,7 +149,8 @@ instance (PrettyCode a, NockNatural a) => PrettyCode (InvalidPath a) where ctx <- ppCtx _invalidPathCtx path <- ppCode _invalidPathPath tm <- ppCode _invalidPathTerm - return (ctx <> "The path" <+> path <+> "is invalid for the following term:" <> line <> tm) + loc <- mapM ppCode _invalidPathLocation + return (ctx <> "The path" <+> path <+> "is invalid for the following term:" <> line <> tm <>? ((line <>) <$> loc)) instance (PrettyCode a, NockNatural a) => PrettyCode (ExpectedAtom a) where ppCode ExpectedAtom {..} = do