108 lines
2.9 KiB
Idris
108 lines
2.9 KiB
Idris
module TypingImpls
|
|
|
|
import TAP
|
|
import public Quox.Typing
|
|
import public Quox.Pretty
|
|
import public TermImpls
|
|
|
|
import Derive.Prelude
|
|
%language ElabReflection
|
|
|
|
|
|
%runElab derive "Reduce.WhnfError" [Show]
|
|
|
|
%runElab deriveIndexed "DimEq" [Show]
|
|
|
|
export %hint
|
|
showTyContext : (PrettyHL q, Show q) => Show (TyContext q d n)
|
|
showTyContext = deriveShow
|
|
|
|
export %hint
|
|
showEqContext : (PrettyHL q, Show q) => Show (EqContext q n)
|
|
showEqContext = deriveShow
|
|
|
|
export %hint
|
|
showTypingError : (PrettyHL q, Show q) => Show (Error q)
|
|
showTypingError = deriveShow
|
|
|
|
export
|
|
ToInfo WhnfError where
|
|
toInfo (MissingEnumArm t ts) =
|
|
[("type", "MissingEnumArm"),
|
|
("tag", show t),
|
|
("list", show ts)]
|
|
|
|
export
|
|
PrettyHL q => ToInfo (Error q) where
|
|
toInfo (NotInScope x) =
|
|
[("type", "NotInScope"),
|
|
("name", show x)]
|
|
toInfo (ExpectedTYPE _ t) =
|
|
[("type", "ExpectedTYPE"),
|
|
("got", prettyStr True t)]
|
|
toInfo (ExpectedPi _ t) =
|
|
[("type", "ExpectedPi"),
|
|
("got", prettyStr True t)]
|
|
toInfo (ExpectedSig _ t) =
|
|
[("type", "ExpectedSig"),
|
|
("got", prettyStr True t)]
|
|
toInfo (ExpectedEnum _ t) =
|
|
[("type", "ExpectedEnum"),
|
|
("got", prettyStr True t)]
|
|
toInfo (ExpectedEq _ t) =
|
|
[("type", "ExpectedEq"),
|
|
("got", prettyStr True t)]
|
|
toInfo (BadUniverse k l) =
|
|
[("type", "BadUniverse"),
|
|
("low", show k),
|
|
("high", show l)]
|
|
toInfo (TagNotIn t ts) =
|
|
[("type", "TagNotIn"),
|
|
("tag", show t),
|
|
("set", show $ SortedSet.toList ts)]
|
|
toInfo (BadCaseQtys _ qouts) =
|
|
("type", "BadCaseQtys") ::
|
|
[(show i, prettyStr True q) | (i, _, _, q) <- zip [1 .. length qouts] qouts]
|
|
|
|
toInfo (ClashT _ mode ty s t) =
|
|
[("type", "ClashT"),
|
|
("mode", show mode),
|
|
("ty", prettyStr True ty),
|
|
("left", prettyStr True s),
|
|
("right", prettyStr True t)]
|
|
toInfo (ClashTy _ mode s t) =
|
|
[("type", "ClashTy"),
|
|
("mode", show mode),
|
|
("left", prettyStr True s),
|
|
("right", prettyStr True t)]
|
|
toInfo (ClashE _ mode e f) =
|
|
[("type", "ClashE"),
|
|
("mode", show mode),
|
|
("left", prettyStr True e),
|
|
("right", prettyStr True f)]
|
|
toInfo (ClashU mode k l) =
|
|
[("type", "ClashU"),
|
|
("mode", show mode),
|
|
("left", show k),
|
|
("right", show l)]
|
|
toInfo (ClashQ pi rh) =
|
|
[("type", "ClashQ"),
|
|
("left", prettyStr True pi),
|
|
("right", prettyStr True rh)]
|
|
toInfo (NotType _ ty) =
|
|
[("type", "NotType"),
|
|
("got", prettyStr True ty)]
|
|
toInfo (WrongType _ ty s t) =
|
|
[("type", "WrongType"),
|
|
("ty", prettyStr True ty),
|
|
("left", prettyStr True s),
|
|
("right", prettyStr True t)]
|
|
|
|
-- [todo] add nested yamls to TAP and include context here
|
|
toInfo (WhileChecking _ _ _ _ err) = toInfo err
|
|
toInfo (WhileCheckingTy _ _ _ err) = toInfo err
|
|
toInfo (WhileInferring _ _ _ err) = toInfo err
|
|
toInfo (WhileComparingT _ _ _ _ _ err) = toInfo err
|
|
toInfo (WhileComparingE _ _ _ _ err) = toInfo err
|
|
|
|
toInfo (WhnfError err) = toInfo err
|