feat: Erase macro scopes in sexp #130
|
@ -327,11 +327,11 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
|
||||||
-- Lean these are handled using a `#` prefix.
|
-- Lean these are handled using a `#` prefix.
|
||||||
pure s!"{deBruijnIndex}"
|
pure s!"{deBruijnIndex}"
|
||||||
| .fvar fvarId =>
|
| .fvar fvarId =>
|
||||||
let name := ofName fvarId.name
|
let name := fvarId.name
|
||||||
pure s!"(:fv {name})"
|
pure s!"(:fv {name})"
|
||||||
| .mvar mvarId => do
|
| .mvar mvarId => do
|
||||||
let pref := if ← mvarId.isDelayedAssigned then "mvd" else "mv"
|
let pref := if ← mvarId.isDelayedAssigned then "mvd" else "mv"
|
||||||
let name := ofName mvarId.name
|
let name := mvarId.name
|
||||||
pure s!"(:{pref} {name})"
|
pure s!"(:{pref} {name})"
|
||||||
| .sort level =>
|
| .sort level =>
|
||||||
let level := serializeSortLevel level sanitize
|
let level := serializeSortLevel level sanitize
|
||||||
|
@ -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
|
||||||
|
@ -387,7 +387,6 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
|
||||||
| .implicit => " :implicit"
|
| .implicit => " :implicit"
|
||||||
| .strictImplicit => " :strictImplicit"
|
| .strictImplicit => " :strictImplicit"
|
||||||
| .instImplicit => " :instImplicit"
|
| .instImplicit => " :instImplicit"
|
||||||
ofName (name: Name) := serializeName name sanitize
|
|
||||||
|
|
||||||
def serializeExpression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.Expression := do
|
def serializeExpression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.Expression := do
|
||||||
let pp?: Option String ← match options.printExprPretty with
|
let pp?: Option String ← match options.printExprPretty with
|
||||||
|
@ -420,13 +419,13 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
|
||||||
match localDecl with
|
match localDecl with
|
||||||
| .cdecl _ fvarId userName _ _ _ =>
|
| .cdecl _ fvarId userName _ _ _ =>
|
||||||
return {
|
return {
|
||||||
name := ofName fvarId.name,
|
name := fvarId.name.toString,
|
||||||
userName:= ofName userName.simpMacroScopes,
|
userName:= ofName userName.simpMacroScopes,
|
||||||
isInaccessible := userName.isInaccessibleUserName
|
isInaccessible := userName.isInaccessibleUserName
|
||||||
}
|
}
|
||||||
| .ldecl _ fvarId userName _ _ _ _ => do
|
| .ldecl _ fvarId userName _ _ _ _ => do
|
||||||
return {
|
return {
|
||||||
name := ofName fvarId.name,
|
name := fvarId.name.toString,
|
||||||
userName := toString userName.simpMacroScopes,
|
userName := toString userName.simpMacroScopes,
|
||||||
isInaccessible := userName.isInaccessibleUserName
|
isInaccessible := userName.isInaccessibleUserName
|
||||||
}
|
}
|
||||||
|
@ -436,7 +435,7 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
|
||||||
let userName := userName.simpMacroScopes
|
let userName := userName.simpMacroScopes
|
||||||
let type ← instantiate type
|
let type ← instantiate type
|
||||||
return {
|
return {
|
||||||
name := ofName fvarId.name,
|
name := fvarId.name.toString,
|
||||||
userName:= ofName userName,
|
userName:= ofName userName,
|
||||||
isInaccessible := userName.isInaccessibleUserName
|
isInaccessible := userName.isInaccessibleUserName
|
||||||
type? := .some (← serializeExpression options type)
|
type? := .some (← serializeExpression options type)
|
||||||
|
@ -450,7 +449,7 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
|
||||||
else
|
else
|
||||||
pure $ .none
|
pure $ .none
|
||||||
return {
|
return {
|
||||||
name := ofName fvarId.name,
|
name := fvarId.name.toString,
|
||||||
userName:= ofName userName,
|
userName:= ofName userName,
|
||||||
isInaccessible := userName.isInaccessibleUserName
|
isInaccessible := userName.isInaccessibleUserName
|
||||||
type? := .some (← serializeExpression options type)
|
type? := .some (← serializeExpression options type)
|
||||||
|
@ -469,7 +468,7 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
|
||||||
| false => ppVar localDecl
|
| false => ppVar localDecl
|
||||||
return var::acc
|
return var::acc
|
||||||
return {
|
return {
|
||||||
name := ofName goal.name,
|
name := goal.name.toString,
|
||||||
userName? := if mvarDecl.userName == .anonymous then .none else .some (ofName mvarDecl.userName),
|
userName? := if mvarDecl.userName == .anonymous then .none else .some (ofName mvarDecl.userName),
|
||||||
isConversion := isLHSGoal? mvarDecl.type |>.isSome,
|
isConversion := isLHSGoal? mvarDecl.type |>.isSome,
|
||||||
target := (← serializeExpression options (← instantiate mvarDecl.type)),
|
target := (← serializeExpression options (← instantiate mvarDecl.type)),
|
||||||
|
|
|
@ -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