1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-12 14:28:08 +03:00

Add syntax highlighting to Core error messages (#1938)

* Closes #1927
This commit is contained in:
Łukasz Czajka 2023-03-28 16:46:18 +02:00 committed by GitHub
parent 9c90dd1390
commit fac6be3bf8
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 17 additions and 15 deletions

View File

@ -4,7 +4,7 @@ import Juvix.Compiler.Core.Language
import Juvix.Compiler.Core.Pretty
data CoreError = CoreError
{ _coreErrorMsg :: Text,
{ _coreErrorMsg :: AnsiText,
_coreErrorNode :: Maybe Node,
_coreErrorLoc :: Location
}
@ -18,15 +18,15 @@ instance ToGenericError CoreError where
return
GenericError
{ _genericErrorLoc = i,
_genericErrorMessage = ppOutput msg,
_genericErrorMessage = msg,
_genericErrorIntervals = [i]
}
where
i = getLoc e
opts' = fromGenericOptions opts
msg = case e ^. coreErrorNode of
Just node -> pretty (e ^. coreErrorMsg) <> colon <> space <> pretty (ppTrace' opts' node)
Nothing -> pretty (e ^. coreErrorMsg)
Just node -> ppOutput (pretty (e ^. coreErrorMsg) <> colon <> space <> doc opts' node)
Nothing -> e ^. coreErrorMsg
instance Pretty CoreError where
pretty (CoreError {..}) = case _coreErrorNode of

View File

@ -267,7 +267,7 @@ catchEvalErrorIO loc ma =
toCoreError :: Location -> EvalError -> CoreError
toCoreError loc (EvalError {..}) =
CoreError
{ _coreErrorMsg = "evaluation error: " <> _evalErrorMsg,
{ _coreErrorMsg = ppOutput $ "evaluation error: " <> pretty _evalErrorMsg,
_coreErrorNode = _evalErrorNode,
_coreErrorLoc = fromMaybe loc (lookupLocation =<< _evalErrorNode)
}

View File

@ -7,6 +7,7 @@ import Juvix.Compiler.Core.Error
import Juvix.Compiler.Core.Extra
import Juvix.Compiler.Core.Info.LocationInfo (getInfoLocation)
import Juvix.Compiler.Core.Transformation.Base
import Juvix.Data.PPOutput
checkGeb :: forall r. Member (Error CoreError) r => InfoTable -> Sem r InfoTable
checkGeb tab =
@ -31,7 +32,7 @@ checkGeb tab =
| isTypeConstr tab (_piBinder ^. binderType) ->
throw
CoreError
{ _coreErrorMsg = "polymorphism not supported for the GEB target",
{ _coreErrorMsg = ppOutput "polymorphism not supported for the GEB target",
_coreErrorNode = Just node,
_coreErrorLoc = fromMaybe defaultLoc (_piBinder ^. binderLocation)
}
@ -74,7 +75,7 @@ checkGeb tab =
when (isCyclic (createIdentDependencyInfo tab)) $
throw
CoreError
{ _coreErrorMsg = "recursion not supported for the GEB target",
{ _coreErrorMsg = ppOutput "recursion not supported for the GEB target",
_coreErrorNode = Nothing,
_coreErrorLoc = defaultLoc
}
@ -84,7 +85,7 @@ checkGeb tab =
when (isCyclic (createTypeDependencyInfo tab)) $
throw
CoreError
{ _coreErrorMsg = "recursive types not supported for the GEB target",
{ _coreErrorMsg = ppOutput "recursive types not supported for the GEB target",
_coreErrorNode = Nothing,
_coreErrorLoc = defaultLoc
}
@ -92,7 +93,7 @@ checkGeb tab =
dynamicTypeError :: Node -> Maybe Location -> CoreError
dynamicTypeError node loc =
CoreError
{ _coreErrorMsg = "compilation for the GEB target requires full type information",
{ _coreErrorMsg = ppOutput "compilation for the GEB target requires full type information",
_coreErrorNode = Just node,
_coreErrorLoc = fromMaybe defaultLoc loc
}
@ -100,7 +101,7 @@ checkGeb tab =
unsupportedError :: Text -> Node -> Maybe Location -> CoreError
unsupportedError what node loc =
CoreError
{ _coreErrorMsg = what <> " not supported for the GEB target",
{ _coreErrorMsg = ppOutput $ pretty what <> " not supported for the GEB target",
_coreErrorNode = Just node,
_coreErrorLoc = fromMaybe defaultLoc loc
}

View File

@ -10,6 +10,7 @@ import Juvix.Compiler.Core.Info.NameInfo (setInfoName)
import Juvix.Compiler.Core.Options
import Juvix.Compiler.Core.Pretty hiding (Options)
import Juvix.Compiler.Core.Transformation.Base
import Juvix.Data.NameKind
data PatternRow = PatternRow
{ _patternRowPatterns :: [Pattern],
@ -86,15 +87,15 @@ goMatchToCase recur node = case node of
| fCoverage ->
throw
CoreError
{ _coreErrorMsg = "Pattern matching not exhaustive. Example pattern sequence not matched: " <> pat,
{ _coreErrorMsg = ppOutput ("Pattern matching not exhaustive. Example pattern sequence not matched: " <> pat),
_coreErrorNode = Nothing,
_coreErrorLoc = fromMaybe defaultLoc (getNodeLocation node)
}
| otherwise ->
return $
mkBuiltinApp' OpFail [mkConstant' (ConstString ("Pattern sequence not matched: " <> pat))]
mkBuiltinApp' OpFail [mkConstant' (ConstString ("Pattern sequence not matched: " <> show pat))]
where
pat = show (ppOutput $ err (replicate (length vs) "_"))
pat = err (replicate (length vs) "_")
mockFile = $(mkAbsFile "/match-to-case")
defaultLoc = singletonInterval (mkInitialLoc mockFile)
r@PatternRow {..} : _
@ -199,7 +200,7 @@ goMatchToCase recur node = case node of
err' tab args =
case mtag of
Just tag ->
err (parensIf (argsNum > 0) (hsep (pretty (ci ^. constructorName) : replicate argsNum "_")) : args)
err (parensIf (argsNum > 0) (hsep (annotate (AnnKind KNameConstructor) (pretty (ci ^. constructorName)) : replicate argsNum "_")) : args)
where
ci = fromJust $ HashMap.lookup tag (tab ^. infoConstructors)
paramsNum = getTypeParamsNum tab (ci ^. constructorType)
@ -220,7 +221,7 @@ goMatchToCase recur node = case node of
vs' = [bindersNum .. bindersNum + argsNum - 1]
err' args =
err
(parensIf (argsNum > paramsNum) (hsep (pretty (ci ^. constructorName) : drop paramsNum (take argsNum args))) : drop argsNum args)
(parensIf (argsNum > paramsNum) (hsep (annotate (AnnKind KNameConstructor) (pretty (ci ^. constructorName)) : drop paramsNum (take argsNum args))) : drop argsNum args)
binders' <- getBranchBinders col matrix tag
matrix' <- getBranchMatrix col matrix tag
body <- compile err' bindersNum' (vs' ++ vs) matrix'