mirror of
https://github.com/anoma/juvix.git
synced 2024-12-12 14:28:08 +03:00
parent
9c90dd1390
commit
fac6be3bf8
@ -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
|
||||
|
@ -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)
|
||||
}
|
||||
|
@ -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
|
||||
}
|
||||
|
@ -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'
|
||||
|
Loading…
Reference in New Issue
Block a user