feat: Erase macro scopes in sexp
This commit is contained in:
parent
1da9180473
commit
a8e7a1a726
|
@ -346,20 +346,20 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
|
||||||
let args := " ".intercalate args
|
let args := " ".intercalate args
|
||||||
pure s!"({fn'} {args})"
|
pure s!"({fn'} {args})"
|
||||||
| .lam binderName binderType body binderInfo => do
|
| .lam binderName binderType body binderInfo => do
|
||||||
let binderName' := ofName binderName
|
let binderName' := binderName.eraseMacroScopes
|
||||||
let binderType' ← self binderType
|
let binderType' ← self binderType
|
||||||
let body' ← self body
|
let body' ← self body
|
||||||
let binderInfo' := binderInfoSexp binderInfo
|
let binderInfo' := binderInfoSexp binderInfo
|
||||||
pure s!"(:lambda {binderName'} {binderType'} {body'}{binderInfo'})"
|
pure s!"(:lambda {binderName'} {binderType'} {body'}{binderInfo'})"
|
||||||
| .forallE binderName binderType body binderInfo => do
|
| .forallE binderName binderType body binderInfo => do
|
||||||
let binderName' := ofName binderName
|
let binderName' := binderName.eraseMacroScopes
|
||||||
let binderType' ← self binderType
|
let binderType' ← self binderType
|
||||||
let body' ← self body
|
let body' ← self body
|
||||||
let binderInfo' := binderInfoSexp binderInfo
|
let binderInfo' := binderInfoSexp binderInfo
|
||||||
pure s!"(:forall {binderName'} {binderType'} {body'}{binderInfo'})"
|
pure s!"(:forall {binderName'} {binderType'} {body'}{binderInfo'})"
|
||||||
| .letE name type value body _ => do
|
| .letE name type value body _ => do
|
||||||
-- Dependent boolean flag diacarded
|
-- Dependent boolean flag diacarded
|
||||||
let name' := serializeName name
|
let name' := name.eraseMacroScopes
|
||||||
let type' ← self type
|
let type' ← self type
|
||||||
let value' ← self value
|
let value' ← self value
|
||||||
let body' ← self body
|
let body' ← self body
|
||||||
|
|
|
@ -32,7 +32,7 @@ def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
|
||||||
def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
|
def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
|
||||||
let entries: List (String × String) := [
|
let entries: List (String × String) := [
|
||||||
-- This one contains unhygienic variable names which must be suppressed
|
-- This one contains unhygienic variable names which must be suppressed
|
||||||
("Nat.add", "(:forall _ (:c Nat) (:forall _ (:c Nat) (:c Nat)))"),
|
("Nat.add", "(:forall a (:c Nat) (:forall a (:c Nat) (:c Nat)))"),
|
||||||
-- These ones are normal and easy
|
-- These ones are normal and easy
|
||||||
("Nat.add_one", "(:forall n (:c Nat) ((:c Eq) (:c Nat) ((:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat)) 0 ((:c OfNat.ofNat) (:c Nat) (:lit 1) ((:c instOfNatNat) (:lit 1)))) ((:c Nat.succ) 0)))"),
|
("Nat.add_one", "(:forall n (:c Nat) ((:c Eq) (:c Nat) ((:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat)) 0 ((:c OfNat.ofNat) (:c Nat) (:lit 1) ((:c instOfNatNat) (:lit 1)))) ((:c Nat.succ) 0)))"),
|
||||||
("Nat.le_of_succ_le", "(:forall n (:c Nat) (:forall m (:c Nat) (:forall h ((:c LE.le) (:c Nat) (:c instLENat) ((:c Nat.succ) 1) 0) ((:c LE.le) (:c Nat) (:c instLENat) 2 1)) :implicit) :implicit)"),
|
("Nat.le_of_succ_le", "(:forall n (:c Nat) (:forall m (:c Nat) (:forall h ((:c LE.le) (:c Nat) (:c instLENat) ((:c Nat.succ) 1) 0) ((:c LE.le) (:c Nat) (:c instLENat) 2 1)) :implicit) :implicit)"),
|
||||||
|
|
|
@ -24,7 +24,7 @@ def test_expr_echo (env: Environment): IO LSpec.TestSeq := do
|
||||||
},
|
},
|
||||||
expr := {
|
expr := {
|
||||||
pp? := "⟨∀ (x : Prop), x → x, fun x h => h⟩",
|
pp? := "⟨∀ (x : Prop), x → x, fun x h => h⟩",
|
||||||
sexp? := "((:c PSigma.mk) (:sort 0) (:lambda p (:sort 0) 0) (:forall x (:sort 0) (:forall _ 0 1)) (:lambda x (:sort 0) (:lambda h 0 0)))",
|
sexp? := "((:c PSigma.mk) (:sort 0) (:lambda p (:sort 0) 0) (:forall x (:sort 0) (:forall a 0 1)) (:lambda x (:sort 0) (:lambda h 0 0)))",
|
||||||
}
|
}
|
||||||
}))
|
}))
|
||||||
return tests
|
return tests
|
||||||
|
|
|
@ -282,9 +282,9 @@ def test_or_comm: TestM Unit := do
|
||||||
serializeExpressionSexp (← instantiateAll state2.parentExpr?.get!) (sanitize := false)
|
serializeExpressionSexp (← instantiateAll state2.parentExpr?.get!) (sanitize := false)
|
||||||
let orPQ := s!"((:c Or) (:fv {fvP}) (:fv {fvQ}))"
|
let orPQ := s!"((:c Or) (:fv {fvP}) (:fv {fvQ}))"
|
||||||
let orQP := s!"((:c Or) (:fv {fvQ}) (:fv {fvP}))"
|
let orQP := s!"((:c Or) (:fv {fvQ}) (:fv {fvP}))"
|
||||||
let motive := s!"(:lambda t._@._hyg.26 {orPQ} (:forall h ((:c Eq) ((:c Or) (:fv {fvP}) (:fv {fvQ})) (:fv {fvH}) 0) {orQP}))"
|
let motive := s!"(:lambda t {orPQ} (:forall h ((:c Eq) ((:c Or) (:fv {fvP}) (:fv {fvQ})) (:fv {fvH}) 0) {orQP}))"
|
||||||
let caseL := s!"(:lambda h._@._hyg.27 (:fv {fvP}) (:lambda h._@._hyg.28 ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inl) (:fv {fvP}) (:fv {fvQ}) 0)) (:subst (:mv {caseL}) (:fv {fvP}) (:fv {fvQ}) 1)))"
|
let caseL := s!"(:lambda h (:fv {fvP}) (:lambda h ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inl) (:fv {fvP}) (:fv {fvQ}) 0)) (:subst (:mv {caseL}) (:fv {fvP}) (:fv {fvQ}) 1)))"
|
||||||
let caseR := s!"(:lambda h._@._hyg.29 (:fv {fvQ}) (:lambda h._@._hyg.30 ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inr) (:fv {fvP}) (:fv {fvQ}) 0)) (:subst (:mv {caseR}) (:fv {fvP}) (:fv {fvQ}) 1)))"
|
let caseR := s!"(:lambda h (:fv {fvQ}) (:lambda h ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inr) (:fv {fvP}) (:fv {fvQ}) 0)) (:subst (:mv {caseR}) (:fv {fvP}) (:fv {fvQ}) 1)))"
|
||||||
let conduit := s!"((:c Eq.refl) {orPQ} (:fv {fvH}))"
|
let conduit := s!"((:c Eq.refl) {orPQ} (:fv {fvH}))"
|
||||||
addTest $ LSpec.test "(2 parent)" (state2parent ==
|
addTest $ LSpec.test "(2 parent)" (state2parent ==
|
||||||
s!"((:c Or.casesOn) (:fv {fvP}) (:fv {fvQ}) {motive} (:fv {fvH}) {caseL} {caseR} {conduit})")
|
s!"((:c Or.casesOn) (:fv {fvP}) (:fv {fvQ}) {motive} (:fv {fvH}) {caseL} {caseR} {conduit})")
|
||||||
|
|
Loading…
Reference in New Issue