rhi/quox
rhi/quox
1
0
Fork 0
Code Issues 15 Pull requests 1 Releases Wiki Activity

pass the subject quantity through equality etc

Browse source 
in preparation for non-linear η laws
This commit is contained in:
rhiannon morris 2023-09-18 18:21:30 +02:00
parent 3fe9b96f05
commit e6c06a5c81
17 changed files with 654 additions and 605 deletions
Download patch file Download diff file Expand all files Collapse all files

84
lib/Quox/Typing/Error.idr
View file

@ -87,7 +87,7 @@ data Error
-- extra context
| WhileChecking
(TyContext d n) Qty
(TyContext d n) SQty
(Term d n) -- term
(Term d n) -- type
Error
@ -97,16 +97,16 @@ data Error
(Maybe Universe)
Error
| WhileInferring
(TyContext d n) Qty
(TyContext d n) SQty
(Elim d n)
Error
| WhileComparingT
(EqContext n) EqMode
(EqContext n) EqMode SQty
(Term 0 n) -- type
(Term 0 n) (Term 0 n) -- lhs/rhs
Error
| WhileComparingE
(EqContext n) EqMode
(EqContext n) EqMode SQty
(Elim 0 n) (Elim 0 n)
Error
%name Error err
@ -119,31 +119,31 @@ ErrorEff = Except Error
export
Located Error where
(ExpectedTYPE loc _ _).loc = loc
(ExpectedPi loc _ _).loc = loc
(ExpectedSig loc _ _).loc = loc
(ExpectedEnum loc _ _).loc = loc
(ExpectedEq loc _ _).loc = loc
(ExpectedNat loc _ _).loc = loc
(ExpectedBOX loc _ _).loc = loc
(BadUniverse loc _ _).loc = loc
(TagNotIn loc _ _).loc = loc
(BadCaseEnum loc _ _).loc = loc
(BadQtys loc _ _ _).loc = loc
(ClashT loc _ _ _ _ _).loc = loc
(ClashTy loc _ _ _ _).loc = loc
(ClashE loc _ _ _ _).loc = loc
(ClashU loc _ _ _).loc = loc
(ClashQ loc _ _).loc = loc
(NotInScope loc _).loc = loc
(NotType loc _ _).loc = loc
(WrongType loc _ _ _).loc = loc
(MissingEnumArm loc _ _).loc = loc
(WhileChecking _ _ _ _ err).loc = err.loc
(WhileCheckingTy _ _ _ err).loc = err.loc
(WhileInferring _ _ _ err).loc = err.loc
(WhileComparingT _ _ _ _ _ err).loc = err.loc
(WhileComparingE _ _ _ _ err).loc = err.loc
(ExpectedTYPE loc _ _).loc = loc
(ExpectedPi loc _ _).loc = loc
(ExpectedSig loc _ _).loc = loc
(ExpectedEnum loc _ _).loc = loc
(ExpectedEq loc _ _).loc = loc
(ExpectedNat loc _ _).loc = loc
(ExpectedBOX loc _ _).loc = loc
(BadUniverse loc _ _).loc = loc
(TagNotIn loc _ _).loc = loc
(BadCaseEnum loc _ _).loc = loc
(BadQtys loc _ _ _).loc = loc
(ClashT loc _ _ _ _ _).loc = loc
(ClashTy loc _ _ _ _).loc = loc
(ClashE loc _ _ _ _).loc = loc
(ClashU loc _ _ _).loc = loc
(ClashQ loc _ _).loc = loc
(NotInScope loc _).loc = loc
(NotType loc _ _).loc = loc
(WrongType loc _ _ _).loc = loc
(MissingEnumArm loc _ _).loc = loc
(WhileChecking _ _ _ _ err).loc = err.loc
(WhileCheckingTy _ _ _ err).loc = err.loc
(WhileInferring _ _ _ err).loc = err.loc
(WhileComparingT _ _ _ _ _ _ err).loc = err.loc
(WhileComparingE _ _ _ _ _ err).loc = err.loc
||| separates out all the error context layers
@ -156,10 +156,10 @@ explodeContext (WhileCheckingTy ctx s k err) =
mapFst (WhileCheckingTy ctx s k ::) $ explodeContext err
explodeContext (WhileInferring ctx x e err) =
mapFst (WhileInferring ctx x e ::) $ explodeContext err
explodeContext (WhileComparingT ctx x s t r err) =
mapFst (WhileComparingT ctx x s t r ::) $ explodeContext err
explodeContext (WhileComparingE ctx x e f err) =
mapFst (WhileComparingE ctx x e f ::) $ explodeContext err
explodeContext (WhileComparingT ctx x sg s t r err) =
mapFst (WhileComparingT ctx x sg s t r ::) $ explodeContext err
explodeContext (WhileComparingE ctx x sg e f err) =
mapFst (WhileComparingE ctx x sg e f ::) $ explodeContext err
explodeContext err = ([], err)
||| leaves the outermost context layer, and the innermost (up to) n, and removes
@ -342,12 +342,12 @@ prettyErrorNoLoc showContext = \case
sep [hsep ["the tag", !(prettyTag tag), "is not contained in"],
!(prettyTerm [<] [<] $ Enum (fromList tags) noLoc)]
WhileChecking ctx pi s a err =>
WhileChecking ctx sg s a err =>
[|vappendBlank
(inTContext ctx . sep =<< sequence
[hangDSingle "while checking" !(prettyTerm ctx.dnames ctx.tnames s),
hangDSingle "has type" !(prettyTerm ctx.dnames ctx.tnames a),
hangDSingle "with quantity" !(prettyQty pi)])
hangDSingle "with quantity" !(prettyQty sg.qty)])
(prettyErrorNoLoc showContext err)|]
WhileCheckingTy ctx a k err =>
@ -357,29 +357,31 @@ prettyErrorNoLoc showContext = \case
pure $ text $ isTypeInUniverse k])
(prettyErrorNoLoc showContext err)|]
WhileInferring ctx pi e err =>
WhileInferring ctx sg e err =>
[|vappendBlank
(inTContext ctx . sep =<< sequence
[hangDSingle "while inferring the type of"
!(prettyElim ctx.dnames ctx.tnames e),
hangDSingle "with quantity" !(prettyQty pi)])
hangDSingle "with quantity" !(prettyQty sg.qty)])
(prettyErrorNoLoc showContext err)|]
WhileComparingT ctx mode a s t err =>
WhileComparingT ctx mode sg a s t err =>
[|vappendBlank
(inEContext ctx . sep =<< sequence
[hangDSingle "while checking that" !(prettyTerm [<] ctx.tnames s),
hangDSingle (text "is \{prettyMode mode}")
!(prettyTerm [<] ctx.tnames t),
hangDSingle "at type" !(prettyTerm [<] ctx.tnames a)])
hangDSingle "at type" !(prettyTerm [<] ctx.tnames a),
hangDSingle "with quantity" !(prettyQty sg.qty)])
(prettyErrorNoLoc showContext err)|]
WhileComparingE ctx mode e f err =>
WhileComparingE ctx mode sg e f err =>
[|vappendBlank
(inEContext ctx . sep =<< sequence
[hangDSingle "while checking that" !(prettyElim [<] ctx.tnames e),
hangDSingle (text "is \{prettyMode mode}")
!(prettyElim [<] ctx.tnames f)])
!(prettyElim [<] ctx.tnames f),
hangDSingle "with quantity" !(prettyQty sg.qty)])
(prettyErrorNoLoc showContext err)|]
where