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

make an optional Loc non-optional

Browse source
This commit is contained in:
rhiannon morris 2023-08-26 20:59:39 +02:00
parent a221380d61
commit 0bcb8c24db
2 changed files with 10 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
lib/Quox/Name.idr
View file

@ -181,12 +181,11 @@ mn base = do
||| generate a fresh binding name with the given base and ||| generate a fresh binding name with the given base and
||| (optionally) location `loc` ||| (optionally) location `loc`
export export
mnb : Has NameGen fs => mnb : Has NameGen fs => PBaseName -> Loc -> Eff fs BindName
PBaseName -> {default noLoc loc : Loc} -> Eff fs BindName mnb base loc = pure $ BN !(mn base) loc
mnb base = pure $ BN !(mn base) loc
export export
fresh : Has NameGen fs => BindName -> Eff fs BindName fresh : Has NameGen fs => BindName -> Eff fs BindName
fresh (BN (UN str) loc) = mnb str {loc} fresh (BN (UN str) loc) = mnb str loc
fresh (BN (MN str k) loc) = mnb str {loc} fresh (BN (MN str k) loc) = mnb str loc
fresh (BN Unused loc) = mnb "x" {loc} fresh (BN Unused loc) = mnb "x" loc

10
lib/Quox/Whnf/TypeCase.idr
View file

@ -43,7 +43,7 @@ parameters {auto _ : CanWhnf Term Interface.isRedexT}
tycasePi (E e) {tnf} = do tycasePi (E e) {tnf} = do
ty <- computeElimType defs ctx e {ne = noOr2 tnf} ty <- computeElimType defs ctx e {ne = noOr2 tnf}
let loc = e.loc let loc = e.loc
narg = mnb "Arg"; nret = mnb "Ret" narg = mnb "Arg" loc; nret = mnb "Ret" loc
arg = E $ typeCase1Y e ty KPi [< !narg, !nret] (BVT 1 loc) loc arg = E $ typeCase1Y e ty KPi [< !narg, !nret] (BVT 1 loc) loc
res' = typeCase1Y e (Arr Zero arg ty loc) KPi [< !narg, !nret] res' = typeCase1Y e (Arr Zero arg ty loc) KPi [< !narg, !nret]
(BVT 0 loc) loc (BVT 0 loc) loc
@ -61,7 +61,7 @@ parameters {auto _ : CanWhnf Term Interface.isRedexT}
tycaseSig (E e) {tnf} = do tycaseSig (E e) {tnf} = do
ty <- computeElimType defs ctx e {ne = noOr2 tnf} ty <- computeElimType defs ctx e {ne = noOr2 tnf}
let loc = e.loc let loc = e.loc
nfst = mnb "Fst"; nsnd = mnb "Snd" nfst = mnb "Fst" loc; nsnd = mnb "Snd" loc
fst = E $ typeCase1Y e ty KSig [< !nfst, !nsnd] (BVT 1 loc) loc fst = E $ typeCase1Y e ty KSig [< !nfst, !nsnd] (BVT 1 loc) loc
snd' = typeCase1Y e (Arr Zero fst ty loc) KSig [< !nfst, !nsnd] snd' = typeCase1Y e (Arr Zero fst ty loc) KSig [< !nfst, !nsnd]
(BVT 0 loc) loc (BVT 0 loc) loc
@ -78,7 +78,7 @@ parameters {auto _ : CanWhnf Term Interface.isRedexT}
tycaseBOX (BOX {ty, _}) = pure ty tycaseBOX (BOX {ty, _}) = pure ty
tycaseBOX (E e) {tnf} = do tycaseBOX (E e) {tnf} = do
ty <- computeElimType defs ctx e {ne = noOr2 tnf} ty <- computeElimType defs ctx e {ne = noOr2 tnf}
pure $ E $ typeCase1Y e ty KBOX [< !(mnb "Ty")] (BVT 0 e.loc) e.loc pure $ E $ typeCase1Y e ty KBOX [< !(mnb "Ty" e.loc)] (BVT 0 e.loc) e.loc
tycaseBOX t = throw $ ExpectedBOX t.loc ctx.names t tycaseBOX t = throw $ ExpectedBOX t.loc ctx.names t
||| for Eq [i ⇒ A] l r, returns (A‹0/i›, A‹1/i›, A, l, r); ||| for Eq [i ⇒ A] l r, returns (A‹0/i›, A‹1/i›, A, l, r);
@ -91,11 +91,11 @@ parameters {auto _ : CanWhnf Term Interface.isRedexT}
tycaseEq (E e) {tnf} = do tycaseEq (E e) {tnf} = do
ty <- computeElimType defs ctx e {ne = noOr2 tnf} ty <- computeElimType defs ctx e {ne = noOr2 tnf}
let loc = e.loc let loc = e.loc
names = traverse' (\x => mnb x) [< "A0", "A1", "A", "L", "R"] names = traverse' (\x => mnb x loc) [< "A0", "A1", "A", "L", "R"]
a0 = E $ typeCase1Y e ty KEq !names (BVT 4 loc) loc a0 = E $ typeCase1Y e ty KEq !names (BVT 4 loc) loc
a1 = E $ typeCase1Y e ty KEq !names (BVT 3 loc) loc a1 = E $ typeCase1Y e ty KEq !names (BVT 3 loc) loc
a' = typeCase1Y e (Eq0 ty a0 a1 loc) KEq !names (BVT 2 loc) loc a' = typeCase1Y e (Eq0 ty a0 a1 loc) KEq !names (BVT 2 loc) loc
a = DST [< !(mnb "i")] $ E $ DApp (dweakE 1 a') (B VZ loc) loc a = DST [< !(mnb "i" loc)] $ E $ DApp (dweakE 1 a') (B VZ loc) loc
l = E $ typeCase1Y e a0 KEq !names (BVT 1 loc) loc l = E $ typeCase1Y e a0 KEq !names (BVT 1 loc) loc
r = E $ typeCase1Y e a1 KEq !names (BVT 0 loc) loc r = E $ typeCase1Y e a1 KEq !names (BVT 0 loc) loc
pure (a0, a1, a, l, r) pure (a0, a1, a, l, r)