Add location information to subTerm error message

Author: paulcadman

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

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