Highlight error source locations

13 files changed, 195 insertions, 112 deletions

diff --git a/src/lib/Actor.hs b/src/lib/Actor.hs
index 1da61268..59ff089a 100644
--- a/src/lib/Actor.hs
+++ b/src/lib/Actor.hs
@@ -10,12 +10,12 @@ module Actor (
   ActorM, Actor (..), launchActor, send, selfMailbox, messageLoop,
   sliceMailbox, SubscribeMsg (..), IncServer, IncServerT, FileWatcher,
   StateServer, flushDiffs, handleSubscribeMsg, subscribe, subscribeIO, sendSync,
-  runIncServerT, launchFileWatcher, Mailbox
+  runIncServerT, launchFileWatcher, Mailbox, launchIncFunctionEvaluator
   ) where
 
 import Control.Concurrent
 import Control.Monad
-import Control.Monad.State.Strict hiding (get)
+import Control.Monad.State.Strict
 import Control.Monad.Reader
 import qualified Data.ByteString as BS
 import Data.IORef
@@ -162,6 +162,36 @@ runIncServerT s cont = do
   ref <- newRef $ IncServerState [] mempty s
   runReaderT (runIncServerT' cont) ref
 
+-- === Incremental function server ===
+
+-- If you just need something that computes a function incrementally and doesn't
+-- need to maintain any other state then this will do.
+
+data IncFunctionEvaluatorMsg da b db =
+   Subscribe_IFEM (SubscribeMsg b db)
+ | Update_IFEM da
+   deriving (Show)
+
+launchIncFunctionEvaluator
+  :: (IncState b db, Show da, MonadIO m)
+  => StateServer a da
+  -> (a -> (b,s))
+  -> (b -> s -> da -> (db, s))
+  -> m (StateServer b db)
+launchIncFunctionEvaluator server fInit fUpdate =
+  sliceMailbox Subscribe_IFEM <$> launchActor do
+    x0 <- subscribe Update_IFEM server
+    let (y0, s0) = fInit x0
+    flip evalStateT s0 $ runIncServerT y0 $ messageLoop \case
+      Subscribe_IFEM msg -> handleSubscribeMsg msg
+      Update_IFEM dx -> do
+        y <- getl It
+        s <- lift get
+        let (dy, s') = fUpdate y s dx
+        lift $ put s'
+        update dy
+        flushDiffs
+
 -- === Refs ===
 -- Just a wrapper around IORef lifted to `MonadIO`
 
diff --git a/src/lib/Err.hs b/src/lib/Err.hs
index 8a7037d2..7405cfbf 100644
--- a/src/lib/Err.hs
+++ b/src/lib/Err.hs
@@ -52,11 +52,11 @@ data Err =
    SearchFailure String      -- used as the identity for `Alternative` instances and for MonadFail.
  | InternalErr String
  | ParseErr  ParseErr
- | SyntaxErr SyntaxErr
- | NameErr   NameErr
- | TypeErr   TypeErr
+ | SyntaxErr SrcId SyntaxErr
+ | NameErr   SrcId NameErr
+ | TypeErr   SrcId TypeErr
  | RuntimeErr
- | MiscErr   MiscErr
+ | MiscErr MiscErr
    deriving (Show, Eq)
 
 type MsgStr  = String
@@ -161,14 +161,11 @@ data InfVarDesc =
 -- === ToErr class ===
 
 class ToErr a where
-  toErr :: a -> Err
+  toErr :: SrcId -> a -> Err
 
-instance ToErr Err where toErr = id
-instance ToErr ParseErr  where toErr = ParseErr
 instance ToErr SyntaxErr where toErr = SyntaxErr
 instance ToErr NameErr   where toErr = NameErr
 instance ToErr TypeErr   where toErr = TypeErr
-instance ToErr MiscErr   where toErr = MiscErr
 
 -- === Error messages ===
 
@@ -180,12 +177,12 @@ instance PrintableErr Err where
     SearchFailure s -> "Internal search failure: " ++ s
     InternalErr s -> "Internal compiler error: " ++ s ++ "\n" ++
       "Please report this at github.com/google-research/dex-lang/issues\n"
-    ParseErr   e -> "Parse error: "  ++ printErr e
-    SyntaxErr  e -> "Syntax error: " ++ printErr e
-    NameErr    e -> "Name error: "   ++ printErr e
-    TypeErr    e -> "Type error: "   ++ printErr e
-    MiscErr    e -> "Error: "        ++ printErr e
-    RuntimeErr   -> "Runtime error"
+    ParseErr    e -> "Parse error: "  ++ printErr e
+    SyntaxErr _ e -> "Syntax error: " ++ printErr e
+    NameErr   _ e -> "Name error: "   ++ printErr e
+    TypeErr   _ e -> "Type error: "   ++ printErr e
+    MiscErr     e -> "Error: "        ++ printErr e
+    RuntimeErr    -> "Runtime error"
 
 instance PrintableErr ParseErr where
   printErr = \case
@@ -257,7 +254,7 @@ instance PrintableErr TypeErr where
     PatternArityErr n1 n2 -> "unexpected number of pattern binders. Expected "   ++ show n1 ++ " but got " ++ show n2
     SumTypeCantFail               -> "sum type constructor in can't-fail pattern"
     PatTypeErr patTy rhsTy        -> "pattern is for a " ++ patTy ++ "but we're matching against a " ++ rhsTy
-    EliminationErr expected ty    -> "expected a " ++ expected ++ ". Got a: " ++ ty
+    EliminationErr expected ty    -> "expected a " ++ expected ++ ". Got: " ++ ty
     IllFormedCasePattern          -> "case patterns must start with a data constructor or variant pattern"
     NotAMethod method className   -> "unexpected method: " ++ method ++ " is not a method of " ++ className
     DuplicateMethod method        -> "duplicate method: " ++ method
@@ -468,7 +465,7 @@ instance Fallible HardFailM where
 -- === convenience layer ===
 
 throw :: (ToErr e, Fallible m) => SrcId -> e -> m a
-throw _ e = throwErr $ toErr e
+throw sid e = throwErr $ toErr sid e
 {-# INLINE throw #-}
 
 getCurrentCallStack :: () -> Maybe [String]
diff --git a/src/lib/Export.hs b/src/lib/Export.hs
index 67e356f6..466afbb5 100644
--- a/src/lib/Export.hs
+++ b/src/lib/Export.hs
@@ -48,11 +48,11 @@ prepareFunctionForExport :: (Mut n, Topper m)
 prepareFunctionForExport cc f = do
   naryPi <- case getType f of
     TyCon (Pi piTy) -> return piTy
-    _ -> throw rootSrcId $ MiscMiscErr "Only first-order functions can be exported"
+    _ -> throwErr $ MiscErr $ MiscMiscErr "Only first-order functions can be exported"
   sig <- liftExportSigM $ corePiToExportSig cc naryPi
   closedSig <- case hoistToTop sig of
     HoistFailure _ ->
-      throw rootSrcId $ MiscMiscErr $ "Types of exported functions have to be closed terms. Got: " ++ pprint naryPi
+      throwErr $ MiscErr $ MiscMiscErr $ "Types of exported functions have to be closed terms. Got: " ++ pprint naryPi
     HoistSuccess s -> return s
   f' <- liftBuilder $ buildCoreLam naryPi \xs -> naryApp (sink f) (toAtom <$> xs)
   fSimp <- simplifyTopFunction $ coreLamToTopLam f'
@@ -68,7 +68,7 @@ prepareSLamForExport cc f@(TopLam _ naryPi _) = do
   sig <- liftExportSigM $ simpPiToExportSig cc naryPi
   closedSig <- case hoistToTop sig of
     HoistFailure _ ->
-      throw rootSrcId $ MiscMiscErr $ "Types of exported functions have to be closed terms. Got: " ++ pprint naryPi
+      throwErr $ MiscErr $ MiscMiscErr $ "Types of exported functions have to be closed terms. Got: " ++ pprint naryPi
     HoistSuccess s -> return s
   fImp <- compileTopLevelFun cc f
   nativeFun <- toCFunction "userFunc" fImp >>= emitObjFile >>= loadObject
@@ -105,7 +105,7 @@ corePiToExportSig :: CallingConvention
 corePiToExportSig cc (CorePiType _ expls tbs (EffTy effs resultTy)) = do
     case effs of
       Pure -> return ()
-      _    -> throw rootSrcId $ MiscMiscErr "Only pure functions can be exported"
+      _    -> throwErr $ MiscErr $ MiscMiscErr "Only pure functions can be exported"
     goArgs cc Empty [] (zipAttrs expls tbs) resultTy
 
 simpPiToExportSig :: CallingConvention
@@ -113,7 +113,7 @@ simpPiToExportSig :: CallingConvention
 simpPiToExportSig cc (PiType bs (EffTy effs resultTy)) = do
   case effs of
     Pure -> return ()
-    _    -> throw rootSrcId $ MiscMiscErr "Only pure functions can be exported"
+    _    -> throwErr $ MiscErr $ MiscMiscErr "Only pure functions can be exported"
   bs' <- return $ fmapNest (\b -> WithAttrB Explicit b) bs
   goArgs cc Empty [] bs' resultTy
 
@@ -164,7 +164,7 @@ toExportType ty = case ty of
     Nothing  -> unsupported
     Just ety -> return ety
   _ -> unsupported
-  where unsupported = throw rootSrcId $ MiscMiscErr $ "Unsupported type of argument in exported function: " ++ pprint ty
+  where unsupported = throwErr $ MiscErr $ MiscMiscErr $ "Unsupported type of argument in exported function: " ++ pprint ty
 {-# INLINE toExportType #-}
 
 parseTabTy :: IRRep r => Type r i -> ExportSigM r i o (Maybe (ExportType o))
diff --git a/src/lib/IncState.hs b/src/lib/IncState.hs
index b5eb01b2..e825bf1e 100644
--- a/src/lib/IncState.hs
+++ b/src/lib/IncState.hs
@@ -9,7 +9,7 @@
 module IncState (
   IncState (..), MapEltUpdate (..), MapUpdate (..),
   Overwrite (..), TailUpdate (..), Unchanging (..), Overwritable (..),
-  mapUpdateMapWithKey) where
+  mapUpdateMapWithKey, MonoidState (..)) where
 
 import Data.Aeson (ToJSON, ToJSONKey)
 import qualified Data.Map.Strict as M
@@ -122,6 +122,12 @@ instance IncState (Overwritable a) (Overwrite a) where
     NoChange         -> s
     OverwriteWith s' -> Overwritable s'
 
+-- Case when the diff and the state are the same
+newtype MonoidState a = MonoidState a
+
+instance Monoid a => IncState (MonoidState a) a where
+  applyDiff (MonoidState d) d' = MonoidState $ d <> d'
+
 
 -- Trivial diff that works for any type - just replace the old value with a completely new one.
 newtype Unchanging a = Unchanging { fromUnchanging :: a } deriving (Show, Eq, Ord)
diff --git a/src/lib/Inference.hs b/src/lib/Inference.hs
index cc10b171..8f6e24fb 100644
--- a/src/lib/Inference.hs
+++ b/src/lib/Inference.hs
@@ -2087,7 +2087,7 @@ trySynthTerm sid ty reqMethodAccess = do
   hasInferenceVars ty >>= \case
     True -> throw sid $ CantSynthInfVars $ pprint ty
     False -> withVoidSubst do
-      synthTy <- liftExcept $ typeAsSynthType ty
+      synthTy <- liftExcept $ typeAsSynthType sid ty
       synthTerm sid synthTy reqMethodAccess
         <|> (throw sid $ CantSynthDict $ pprint ty)
 {-# SCC trySynthTerm #-}
@@ -2126,15 +2126,15 @@ extendGivens newGivens cont = do
 {-# INLINE extendGivens #-}
 
 getSynthType :: SynthAtom n -> SynthType n
-getSynthType x = ignoreExcept $ typeAsSynthType (getType x)
+getSynthType x = ignoreExcept $ typeAsSynthType rootSrcId (getType x)
 {-# INLINE getSynthType #-}
 
-typeAsSynthType :: CType n -> Except (SynthType n)
-typeAsSynthType = \case
+typeAsSynthType :: SrcId -> CType n -> Except (SynthType n)
+typeAsSynthType sid = \case
   TyCon (DictTy dictTy) -> return $ SynthDictType dictTy
   TyCon (Pi (CorePiType ImplicitApp expls bs (EffTy Pure (TyCon (DictTy d))))) ->
     return $ SynthPiType (expls, Abs bs d)
-  ty -> Failure $ toErr $ NotASynthType $ pprint ty
+  ty -> Failure $ toErr sid $ NotASynthType $ pprint ty
 {-# SCC typeAsSynthType #-}
 
 getSuperclassClosure :: EnvReader m => Givens n -> [SynthAtom n] -> m n (Givens n)
@@ -2259,7 +2259,7 @@ emptyMixedArgs = ([], [])
 
 typeErrAsSearchFailure :: InfererM i n a -> InfererM i n a
 typeErrAsSearchFailure cont = cont `catchErr` \case
-  TypeErr _ -> empty
+  TypeErr _ _ -> empty
   e -> throwErr e
 
 synthDictForData :: forall i n. SrcId -> DictType n -> InfererM i n (SynthAtom n)
diff --git a/src/lib/Lexing.hs b/src/lib/Lexing.hs
index e8ad7c7f..46290282 100644
--- a/src/lib/Lexing.hs
+++ b/src/lib/Lexing.hs
@@ -44,7 +44,7 @@ type Parser = StateT ParseCtx (Parsec Void Text)
 
 parseit :: Text -> Parser a -> Except a
 parseit s p = case parse (fst <$> runStateT p initParseCtx) "" s of
-  Left e  -> throw rootSrcId $ MiscParseErr $ errorBundlePretty e
+  Left e  -> throwErr $ ParseErr $ MiscParseErr $ errorBundlePretty e
   Right x -> return x
 
 mustParseit :: Text -> Parser a -> a
diff --git a/src/lib/Live/Eval.hs b/src/lib/Live/Eval.hs
index 89fcd3e3..97f99761 100644
--- a/src/lib/Live/Eval.hs
+++ b/src/lib/Live/Eval.hs
@@ -7,7 +7,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 module Live.Eval (
-  watchAndEvalFile, EvalServer, EvalUpdate, CellsUpdate, fmapCellsUpdate,
+  watchAndEvalFile, EvalServer, EvalUpdate, CellsState, CellsUpdate, fmapCellsUpdate,
   NodeList (..), NodeListUpdate (..), subscribeIO, nodeListAsUpdate) where
 
 import Control.Concurrent
diff --git a/src/lib/Live/Web.hs b/src/lib/Live/Web.hs
index 4e23d805..0f5739a8 100644
--- a/src/lib/Live/Web.hs
+++ b/src/lib/Live/Web.hs
@@ -22,16 +22,18 @@ import qualified Data.ByteString as BS
 
 import Live.Eval
 import RenderHtml
+import IncState
+import Actor
 import TopLevel
 import Types.Source
 
 runWeb :: FilePath -> EvalConfig -> TopStateEx -> IO ()
 runWeb fname opts env = do
-  resultsChan <- watchAndEvalFile fname opts env
+  resultsChan <- watchAndEvalFile fname opts env >>= renderResults
   putStrLn "Streaming output to http://localhost:8000/"
   run 8000 $ serveResults resultsChan
 
-serveResults :: EvalServer -> Application
+serveResults :: RenderedResultsServer -> Application
 serveResults resultsSubscribe request respond = do
   print (pathInfo request)
   case pathInfo request of
@@ -50,14 +52,15 @@ serveResults resultsSubscribe request respond = do
       -- fname <- getDataFileName dataFname
       respond $ responseFile status200 [("Content-Type", ctype)] fname Nothing
 
-resultStream :: EvalServer -> StreamingBody
+type RenderedResultsServer = StateServer (MonoidState RenderedResults) RenderedResults
+type RenderedResults = CellsUpdate RenderedSourceBlock RenderedOutputs
+
+resultStream :: RenderedResultsServer -> StreamingBody
 resultStream resultsServer write flush = do
   sendUpdate ("start"::String)
-  (initResult, resultsChan) <- subscribeIO resultsServer
-  sendUpdate $ renderEvalUpdate $ nodeListAsUpdate initResult
-  forever do
-    nextUpdate <- readChan resultsChan
-    sendUpdate $ renderEvalUpdate nextUpdate
+  (MonoidState initResult, resultsChan) <- subscribeIO resultsServer
+  sendUpdate initResult
+  forever $ readChan resultsChan >>= sendUpdate
   where
     sendUpdate :: ToJSON a => a -> IO ()
     sendUpdate x = write (fromByteString $ encodePacket x) >> flush
@@ -66,6 +69,11 @@ encodePacket :: ToJSON a => a -> BS.ByteString
 encodePacket = toStrict . wrap . encode
   where wrap s = "data:" <> s <> "\n\n"
 
+renderResults :: EvalServer -> IO RenderedResultsServer
+renderResults evalServer = launchIncFunctionEvaluator evalServer
+   (\x -> (MonoidState $ renderEvalUpdate $ nodeListAsUpdate x, ()))
+   (\_ () dx -> (renderEvalUpdate dx, ()))
+
 renderEvalUpdate :: CellsUpdate SourceBlock Outputs -> CellsUpdate RenderedSourceBlock RenderedOutputs
 renderEvalUpdate cellsUpdate = fmapCellsUpdate cellsUpdate
   (\k b -> renderSourceBlock k b)
diff --git a/src/lib/RenderHtml.hs b/src/lib/RenderHtml.hs
index e4015c6a..da8e8a28 100644
--- a/src/lib/RenderHtml.hs
+++ b/src/lib/RenderHtml.hs
@@ -19,6 +19,7 @@ import Data.Aeson (ToJSON)
 import qualified Data.Map.Strict as M
 import Control.Monad.State.Strict
 import Control.Monad.Writer.Strict
+import Data.Foldable (fold)
 import Data.Functor ((<&>))
 import Data.Maybe (fromJust)
 import Data.String (fromString)
@@ -29,10 +30,11 @@ import System.IO.Unsafe
 import GHC.Generics
 
 import Err
+import IncState
 import Paths_dex (getDataFileName)
 import PPrint
 import Types.Source
-import Util (unsnoc, foldJusts)
+import Util (unsnoc)
 
 -- === rendering results ===
 
@@ -50,15 +52,22 @@ data RenderedSourceBlock = RenderedSourceBlock
 
 data RenderedOutputs = RenderedOutputs
   { rrHtml         :: String
+  , rrLexemeSpans  :: SpanMap
   , rrHighlightMap :: HighlightMap
-  , rrHoverInfoMap :: HoverInfoMap }
+  , rrHoverInfoMap :: HoverInfoMap
+  , rrErrorSrcIds  :: [SrcId] }
   deriving (Generic)
 
 renderOutputs :: Outputs -> RenderedOutputs
-renderOutputs r = RenderedOutputs
-  { rrHtml         = pprintHtml r
+renderOutputs (Outputs outputs) = fold $ map renderOutput outputs
+
+renderOutput :: Output -> RenderedOutputs
+renderOutput r = RenderedOutputs
+  { rrHtml         = pprintHtml        r
+  , rrLexemeSpans  = computeSpanMap    r
   , rrHighlightMap = computeHighlights r
-  , rrHoverInfoMap = computeHoverInfo r }
+  , rrHoverInfoMap = computeHoverInfo  r
+  , rrErrorSrcIds  = computeErrSrcIds  r}
 
 renderSourceBlock :: BlockId -> SourceBlock -> RenderedSourceBlock
 renderSourceBlock n b = RenderedSourceBlock
@@ -83,38 +92,60 @@ instance ToMarkup Output where
 instance ToJSON RenderedOutputs
 instance ToJSON RenderedSourceBlock
 
+instance Semigroup RenderedOutputs where
+  RenderedOutputs x1 y1 z1 w1 v1 <> RenderedOutputs x2 y2 z2 w2 v2 =
+    RenderedOutputs (x1<>x2) (y1<>y2) (z1<>z2) (w1<>w2) (v1<>v2)
+
+instance Monoid RenderedOutputs where
+  mempty = RenderedOutputs mempty mempty mempty mempty mempty
+
 -- === textual information on hover ===
 
 type HoverInfo = String
 newtype HoverInfoMap = HoverInfoMap (M.Map LexemeId HoverInfo)   deriving (ToJSON, Semigroup, Monoid)
 
-computeHoverInfo :: Outputs -> HoverInfoMap
-computeHoverInfo (Outputs outputs) = do
-  let typeInfo = foldJusts outputs \case
-        SourceInfo (SITypeInfo m) -> Just m
-        _ -> Nothing
-  HoverInfoMap $ fromTypeInfo typeInfo
+computeHoverInfo :: Output -> HoverInfoMap
+computeHoverInfo (SourceInfo (SITypeInfo m)) = HoverInfoMap $ fromTypeInfo m
+computeHoverInfo _ = mempty
 
 -- === highlighting on hover ===
 
-newtype FocusMap = FocusMap (M.Map LexemeId SrcId)   deriving (ToJSON, Semigroup, Monoid)
+newtype SpanMap      = SpanMap (M.Map SrcId LexemeSpan)       deriving (ToJSON, Semigroup, Monoid)
 newtype HighlightMap = HighlightMap (M.Map SrcId Highlights)  deriving (ToJSON, Semigroup, Monoid)
-type Highlights = [(HighlightType, LexemeSpan)]
+type Highlights = [(HighlightType, SrcId)]
 data HighlightType = HighlightGroup | HighlightLeaf  deriving Generic
 
 instance ToJSON HighlightType
 
-computeHighlights :: Outputs -> HighlightMap
-computeHighlights (Outputs outputs) = do
-  execWriter $ mapM go $ foldJusts outputs \case
-    SourceInfo (SIGroupTree t) -> Just t
-    _ -> Nothing
- where
+computeErrSrcIds :: Output -> [SrcId]
+computeErrSrcIds (Error err) = case err of
+  SearchFailure _ -> []
+  InternalErr   _ -> []
+  ParseErr      _ -> []
+  SyntaxErr sid _ -> [sid]
+  NameErr   sid _ -> [sid]
+  TypeErr   sid _ -> [sid]
+  RuntimeErr -> []
+  MiscErr _  -> []
+computeErrSrcIds _ = []
+
+computeSpanMap :: Output -> SpanMap
+computeSpanMap (SourceInfo (SIGroupTree (OverwriteWith tree))) =
+  execWriter $ go tree where
+  go :: GroupTree -> Writer SpanMap ()
+  go t = do
+    tell $ SpanMap $ M.singleton (gtSrcId t) (gtSpan t)
+    mapM_ go $ gtChildren t
+computeSpanMap _ = mempty
+
+computeHighlights :: Output -> HighlightMap
+computeHighlights (SourceInfo (SIGroupTree (OverwriteWith tree))) =
+  execWriter $ go tree where
   go :: GroupTree -> Writer HighlightMap ()
   go t = do
     let children = gtChildren t
     let highlights = children <&> \child ->
-          (getHighlightType (gtIsAtomicLexeme child), gtSpan child)
+          (getHighlightType (gtIsAtomicLexeme child), gtSrcId child)
     forM_ children \child-> do
       tell $ HighlightMap $ M.singleton (gtSrcId child) highlights
       go child
@@ -122,6 +153,7 @@ computeHighlights (Outputs outputs) = do
   getHighlightType :: Bool -> HighlightType
   getHighlightType True  = HighlightLeaf
   getHighlightType False = HighlightGroup
+computeHighlights _ = mempty
 
 -- -----------------
 
diff --git a/src/lib/Runtime.hs b/src/lib/Runtime.hs
index 011604d8..885088c2 100644
--- a/src/lib/Runtime.hs
+++ b/src/lib/Runtime.hs
@@ -72,7 +72,7 @@ checkedCallFunPtr :: FD -> Ptr () -> Ptr () -> DexExecutable -> IO ()
 checkedCallFunPtr fd argsPtr resultPtr fPtr = do
   let (CInt fd') = fdFD fd
   exitCode <- callFunPtr fPtr fd' argsPtr resultPtr
-  unless (exitCode == 0) $ throw rootSrcId RuntimeErr
+  unless (exitCode == 0) $ throwErr RuntimeErr
 
 withPipeToLogger :: PassLogger -> (FD -> IO a) -> IO a
 withPipeToLogger logger writeAction = do
diff --git a/src/lib/TopLevel.hs b/src/lib/TopLevel.hs
index 5f0f84ea..d1932bbf 100644
--- a/src/lib/TopLevel.hs
+++ b/src/lib/TopLevel.hs
@@ -263,7 +263,7 @@ evalSourceBlock' mname block = case sbContents block of
   DeclareForeign fname (WithSrc _ dexName) cTy -> do
     ty <- evalUType =<< parseExpr cTy
     asFFIFunType ty >>= \case
-      Nothing -> throw rootSrcId $ MiscMiscErr
+      Nothing -> throwErr $ MiscErr $ MiscMiscErr
         "FFI functions must be n-ary first order functions with the IO effect"
       Just (impFunTy, naryPiTy) -> do
         -- TODO: query linking stuff and check the function is actually available
@@ -279,11 +279,11 @@ evalSourceBlock' mname block = case sbContents block of
       Just (UAtomVar fname') -> do
         lookupCustomRules fname' >>= \case
           Nothing -> return ()
-          Just _  -> throw rootSrcId $ MiscMiscErr
+          Just _  -> throwErr $ MiscErr $ MiscMiscErr
             $ pprint fname ++ " already has a custom linearization"
         lookupAtomName fname' >>= \case
           NoinlineFun _ _ -> return ()
-          _ -> throw rootSrcId $ MiscMiscErr "Custom linearizations only apply to @noinline functions"
+          _ -> throwErr $ MiscErr $ MiscMiscErr "Custom linearizations only apply to @noinline functions"
         -- We do some special casing to avoid instantiating polymorphic functions.
         impl <- case expr of
           WithSrcE _ (UVar _) ->
@@ -296,13 +296,13 @@ evalSourceBlock' mname block = case sbContents block of
         liftEnvReaderT (impl `checkTypeIs` linFunTy) >>= \case
           Failure _ -> do
             let implTy = getType impl
-            throw rootSrcId $ MiscMiscErr $ unlines
+            throwErr $ MiscErr $ MiscMiscErr $ unlines
               [ "Expected the custom linearization to have type:" , "" , pprint linFunTy , ""
               , "but it has type:" , "" , pprint implTy]
           Success () -> return ()
         updateTopEnv $ AddCustomRule fname' $ CustomLinearize nimplicit nexplicit zeros impl
-      Just _ -> throw rootSrcId $ MiscMiscErr $ "Custom linearization can only be defined for functions"
-  UnParseable _ s -> throw rootSrcId $ MiscParseErr s
+      Just _ -> throwErr $ MiscErr $ MiscMiscErr $ "Custom linearization can only be defined for functions"
+  UnParseable _ s -> throwErr $ ParseErr $ MiscParseErr s
   Misc m -> case m of
     GetNameType v -> do
       lookupSourceMap (withoutSrc v) >>= \case
@@ -437,7 +437,7 @@ evalUModule (UModule name _ blocks) = do
 importModule :: (Mut n, TopBuilder m, Fallible1 m) => ModuleSourceName -> m n ()
 importModule name = do
   lookupLoadedModule name >>= \case
-    Nothing -> throw rootSrcId $ ModuleImportErr $ pprint name
+    Nothing -> throwErr $ MiscErr $ ModuleImportErr $ pprint name
     Just name' -> do
       Module _ _ transImports' _ _ <- lookupModule name'
       let importStatus = ImportStatus (S.singleton name')
@@ -696,7 +696,7 @@ loadModuleSource config moduleName = do
       fsPaths <- liftIO $ traverse resolveBuiltinPath $ libPaths config
       liftIO (findFile fsPaths fname) >>= \case
         Just fpath -> return fpath
-        Nothing    -> throw rootSrcId $ CantFindModuleSource $ pprint moduleName
+        Nothing    -> throwErr $ MiscErr $ CantFindModuleSource $ pprint moduleName
     resolveBuiltinPath = \case
       LibBuiltinPath   -> liftIO $ getDataFileName "lib"
       LibDirectory dir -> return dir
@@ -835,14 +835,14 @@ getLinearizationType zeros = \case
         Just tty -> case zeros of
           InstantiateZeros -> return tty
           SymbolicZeros    -> symbolicTangentTy tty
-        Nothing  -> throw rootSrcId $ MiscMiscErr $ "No tangent type for: " ++ pprint t
+        Nothing  -> throwErr $ MiscErr $ MiscMiscErr $ "No tangent type for: " ++ pprint t
       resultTanTy <- maybeTangentType resultTy' >>= \case
         Just rtt -> return rtt
-        Nothing  -> throw rootSrcId $ MiscMiscErr $ "No tangent type for: " ++ pprint resultTy'
+        Nothing  -> throwErr $ MiscErr $ MiscMiscErr $ "No tangent type for: " ++ pprint resultTy'
       let tanFunTy = toType $ Pi $ nonDepPiType argTanTys Pure resultTanTy
       let fullTy = CorePiType ExplicitApp expls bs' $ EffTy Pure (PairTy resultTy' tanFunTy)
       return (numIs, numEs, toType $ Pi fullTy)
-  _ -> throw rootSrcId $ MiscMiscErr $ "Can't define a custom linearization for implicit or impure functions"
+  _ -> throwErr $ MiscErr $ MiscMiscErr $ "Can't define a custom linearization for implicit or impure functions"
   where
     getNumImplicits :: Fallible m => [Explicitness] -> m (Int, Int)
     getNumImplicits = \case
@@ -853,4 +853,4 @@ getLinearizationType zeros = \case
           Inferred _ _ -> return (ni + 1, ne)
           Explicit -> case ni of
             0 -> return (0, ne + 1)
-            _ -> throw rootSrcId $ MiscMiscErr "All implicit args must precede implicit args"
+            _ -> throwErr $ MiscErr $ MiscMiscErr "All implicit args must precede implicit args"
diff --git a/static/index.js b/static/index.js
index 3be1aea5..6aa93849 100644
--- a/static/index.js
+++ b/static/index.js
@@ -29,18 +29,10 @@ function renderLaTeX(root) {
     );
 }
 
-/**
- * HTML rendering mode.
- * Static rendering is used for static HTML pages.
- * Dynamic rendering is used for dynamic HTML pages via `dex web`.
- *
- * @enum {string}
- */
 var RENDER_MODE = Object.freeze({
   STATIC: "static",
   DYNAMIC: "dynamic",
 })
-
 var body         = document.getElementById("main-output");
 var hoverInfoDiv = document.getElementById("hover-info");
 
@@ -48,8 +40,8 @@ var hoverInfoDiv = document.getElementById("hover-info");
 var cells = {}
 var frozenHover = false;
 var curHighlights = [];  // HTML elements currently highlighted
-var focusMap     = {}
 var highlightMap = {}
+var spanMap      = {}
 var hoverInfoMap = {}
 
 function removeHover() {
@@ -77,16 +69,25 @@ function applyHoverInfo(cellId, srcId) {
         hoverInfoDiv.innerHTML = hoverInfo
     }
 }
+function getSpan(cellId, srcId) {
+    return lookupSrcMap(spanMap, cellId, srcId)
+}
 function applyHoverHighlights(cellId, srcId) {
     let highlights = lookupSrcMap(highlightMap, cellId, srcId)
     if (highlights == null) return
     highlights.map(function (highlight) {
-        let [highlightType, [l, r]] = highlight
-        let spans = spansBetween(selectSpan(cellId, l), selectSpan(cellId, r));
+        let [highlightType, highlightSrcId] = highlight
         let highlightClass = getHighlightClass(highlightType)
+        addClass(cellId, highlightSrcId, highlightClass)})
+}
+function addClass(cellId, srcId, className) {
+    let span = getSpan(cellId, srcId)
+    if (span !== undefined) {
+        let [l, r] = span
+        let spans = spansBetween(selectSpan(cellId, l), selectSpan(cellId, r));
         spans.map(function (span) {
-            span.classList.add(highlightClass)
-            curHighlights.push(span)})})
+            span.classList.add(className)
+            curHighlights.push(span)})}
 }
 function toggleFrozenHover() {
     if (frozenHover) {
@@ -103,30 +104,6 @@ function attachHovertip(cellId, srcId) {
     span.addEventListener("mouseout" , function (event) {
         event.stopPropagation()
         removeHover()})}
-
-/**
- * Renders the webpage.
- * @param {RENDER_MODE} renderMode The render mode, either static or dynamic.
- */
-function render(renderMode) {
-    if (renderMode == RENDER_MODE.STATIC) {
-        // For static pages, simply call rendering functions once.
-        renderLaTeX(document);
-    } else {
-        // For dynamic pages (via `dex web`), listen to update events.
-        var source = new EventSource("/getnext");
-        source.onmessage = function(event) {
-            var msg = JSON.parse(event.data);
-            if (msg == "start") {
-                body.innerHTML = ""
-                body.addEventListener("click", function (event) {
-                    event.stopPropagation()
-                    toggleFrozenHover()})
-                cells = {}
-                return
-            } else {
-                processUpdate(msg)}};}
-}
 function selectSpan(cellId, srcId) {
     return cells[cellId].querySelector("#span_".concat(cellId, "_", srcId))
 }
@@ -177,6 +154,7 @@ function initializeCellContents(cellId, cell, contents) {
     let sourceText = source["rsbHtml"];
     highlightMap[cellId] = {};
     hoverInfoMap[cellId] = {};
+    spanMap[cellId]      = {};
     addChild(cell, "line-num"    , lineNum.toString())
     addChild(cell, "code-block"  , sourceText)
     addChild(cell, "cell-results", "")
@@ -192,6 +170,11 @@ function extendCellResult(cellId, cell, result) {
     }
     Object.assign(highlightMap[cellId], result["rrHighlightMap"])
     Object.assign(hoverInfoMap[cellId], result["rrHoverInfoMap"])
+    Object.assign(spanMap[cellId]     , result["rrLexemeSpans"])
+
+    let errSrcIds = result["rrErrorSrcIds"]
+    errSrcIds.map(function (srcId) {
+        addClass(cellId, srcId, "err-span")})
 }
 function updateCellContents(cellId, cell, contents) {
     let [statusUpdate, result] = contents;
@@ -238,3 +221,27 @@ function processUpdate(msg) {
             let lexemeList = source["rsbLexemeList"];
             lexemeList.map(function (lexemeId) {attachHovertip(cellId, lexemeId.toString())})}});
 }
+
+/**
+ * Renders the webpage.
+ * @param {RENDER_MODE} renderMode The render mode, either static or dynamic.
+ */
+function render(renderMode) {
+    if (renderMode == RENDER_MODE.STATIC) {
+        // For static pages, simply call rendering functions once.
+        renderLaTeX(document);
+    } else {
+        // For dynamic pages (via `dex web`), listen to update events.
+        var source = new EventSource("/getnext");
+        source.onmessage = function(event) {
+            var msg = JSON.parse(event.data);
+            if (msg == "start") {
+                body.innerHTML = ""
+                body.addEventListener("click", function (event) {
+                    event.stopPropagation()
+                    toggleFrozenHover()})
+                cells = {}
+                return
+            } else {
+                processUpdate(msg)}};}
+}
diff --git a/static/style.css b/static/style.css
index 3d8de7c6..450f70bf 100644
--- a/static/style.css
+++ b/static/style.css
@@ -40,7 +40,10 @@ body {
   font-family: monospace;
   white-space: pre;
 }
-
+.err-span {
+  text-decoration: red wavy underline;
+  text-decoration-skip-ink: none;
+}
 code {
   background-color: #F0F0F0;
 }