feat: Print constructor and recursor info

This commit is contained in:
Leni Aniva 2024-01-16 14:11:52 -08:00
parent a1421439f8
commit 93a34f9fda
Signed by: aniva
GPG Key ID: 4D9B1C8D10EA4C50
4 changed files with 79 additions and 12 deletions

View File

@ -56,6 +56,7 @@ def inspect (args: Protocol.EnvInspect) (options: Protocol.Options): CoreM (CR P
-- Information common to all symbols -- Information common to all symbols
let core := { let core := {
type := ← (serialize_expression options info.type).run', type := ← (serialize_expression options info.type).run',
isUnsafe := info.isUnsafe,
value? := ← value?.mapM (λ v => serialize_expression options v |>.run'), value? := ← value?.mapM (λ v => serialize_expression options v |>.run'),
publicName? := Lean.privateToUserName? name |>.map (·.toString), publicName? := Lean.privateToUserName? name |>.map (·.toString),
-- BUG: Warning: getUsedConstants here will not include projections. This is a known bug. -- BUG: Warning: getUsedConstants here will not include projections. This is a known bug.
@ -70,10 +71,23 @@ def inspect (args: Protocol.EnvInspect) (options: Protocol.Options): CoreM (CR P
all := induct.all.map (·.toString), all := induct.all.map (·.toString),
ctors := induct.ctors.map (·.toString), ctors := induct.ctors.map (·.toString),
isRec := induct.isRec, isRec := induct.isRec,
isUnsafe := induct.isUnsafe,
isReflexive := induct.isReflexive, isReflexive := induct.isReflexive,
isNested := induct.isNested, isNested := induct.isNested,
} } } }
| .ctorInfo ctor => { core with constructorInfo? := .some {
induct := ctor.induct.toString,
cidx := ctor.cidx,
numParams := ctor.numParams,
numFields := ctor.numFields,
} }
| .recInfo r => { core with recursorInfo? := .some {
all := r.all.map (·.toString),
numParams := r.numParams,
numIndices := r.numIndices,
numMotives := r.numMotives,
numMinors := r.numMinors,
k := r.k,
} }
| _ => core | _ => core
return .ok result return .ok result
def addDecl (args: Protocol.EnvAdd): CoreM (CR Protocol.EnvAddResult) := do def addDecl (args: Protocol.EnvAdd): CoreM (CR Protocol.EnvAddResult) := do

View File

@ -127,19 +127,36 @@ structure InductInfo where
all: List String all: List String
ctors: List String ctors: List String
isRec: Bool := false isRec: Bool := false
isUnsafe: Bool := false
isReflexive: Bool := false isReflexive: Bool := false
isNested: Bool := false isNested: Bool := false
deriving Lean.ToJson deriving Lean.ToJson
-- See `ConstructorVal`
structure ConstructorInfo where
induct: String
cidx: Nat
numParams: Nat
numFields: Nat
deriving Lean.ToJson
structure RecursorInfo where
all: List String
numParams: Nat
numIndices: Nat
numMotives: Nat
numMinors: Nat
k: Bool
deriving Lean.ToJson
structure EnvInspectResult where structure EnvInspectResult where
type: Expression type: Expression
isUnsafe: Bool := false
value?: Option Expression := .none value?: Option Expression := .none
module?: Option String := .none module?: Option String := .none
-- If the name is private, displays the public facing name -- If the name is private, displays the public facing name
publicName?: Option String := .none publicName?: Option String := .none
typeDependency?: Option (Array String) := .none typeDependency?: Option (Array String) := .none
valueDependency?: Option (Array String) := .none valueDependency?: Option (Array String) := .none
inductInfo?: Option InductInfo := .none inductInfo?: Option InductInfo := .none
constructorInfo?: Option ConstructorInfo := .none
recursorInfo?: Option RecursorInfo := .none
deriving Lean.ToJson deriving Lean.ToJson
structure EnvAdd where structure EnvAdd where

View File

@ -9,6 +9,8 @@ open Pantograph
open Lean open Lean
deriving instance DecidableEq, Repr for Protocol.InductInfo deriving instance DecidableEq, Repr for Protocol.InductInfo
deriving instance DecidableEq, Repr for Protocol.ConstructorInfo
deriving instance DecidableEq, Repr for Protocol.RecursorInfo
deriving instance DecidableEq, Repr for Protocol.EnvInspectResult deriving instance DecidableEq, Repr for Protocol.EnvInspectResult
def test_symbol_visibility (env: Environment): IO LSpec.TestSeq := do def test_symbol_visibility (env: Environment): IO LSpec.TestSeq := do
@ -22,20 +24,54 @@ def test_symbol_visibility (env: Environment): IO LSpec.TestSeq := do
LSpec.TestSeq.append suites test) LSpec.TestSeq.done LSpec.TestSeq.append suites test) LSpec.TestSeq.done
return suite return suite
inductive ConstantCat where
| induct (info: Protocol.InductInfo)
| ctor (info: Protocol.ConstructorInfo)
| recursor (info: Protocol.RecursorInfo)
def test_inspect (env: Environment): IO LSpec.TestSeq := do def test_inspect (env: Environment): IO LSpec.TestSeq := do
let inner: CoreM LSpec.TestSeq := do let testCases: List (String × ConstantCat) := [
let args: Protocol.EnvInspect := { name := "Or" } ("Or", ConstantCat.induct {
let result ← match ← Environment.inspect args (options := {}) with
| .ok result => pure $ result
| .error e => panic! s!"Error: {e.desc}"
--IO.println s!"{reprStr result.inductInfo?}"
let test := LSpec.check "Or" (result.inductInfo? == .some {
numParams := 2, numParams := 2,
numIndices := 0, numIndices := 0,
all := ["Or"], all := ["Or"],
ctors := ["Or.inl", "Or.inr"], ctors := ["Or.inl", "Or.inr"],
}),
("Except.ok", ConstantCat.ctor {
induct := "Except",
cidx := 1,
numParams := 2,
numFields := 1,
}),
("Eq.rec", ConstantCat.recursor {
all := ["Eq"],
numParams := 2,
numIndices := 1,
numMotives := 1,
numMinors := 1,
k := true,
}),
("ForM.rec", ConstantCat.recursor {
all := ["ForM"],
numParams := 3,
numIndices := 0,
numMotives := 1,
numMinors := 1,
k := false,
}) })
return LSpec.TestSeq.append LSpec.TestSeq.done test ]
let inner: CoreM LSpec.TestSeq := do
testCases.foldlM (λ acc (name, cat) => do
let args: Protocol.EnvInspect := { name := name }
let result ← match ← Environment.inspect args (options := {}) with
| .ok result => pure $ result
| .error e => panic! s!"Error: {e.desc}"
let p := match cat with
| .induct info => LSpec.test name (result.inductInfo? == .some info)
| .ctor info => LSpec.test name (result.constructorInfo? == .some info)
| .recursor info => LSpec.test name (result.recursorInfo? == .some info)
return LSpec.TestSeq.append acc p
) LSpec.TestSeq.done
runCoreMSeq env inner runCoreMSeq env inner
def suite: IO LSpec.TestSeq := do def suite: IO LSpec.TestSeq := do

View File

@ -70,7 +70,7 @@ def test_instance (env: Environment): IO LSpec.TestSeq := do
let env ← MonadEnv.getEnv let env ← MonadEnv.getEnv
let source := "λ x y: Nat => HAdd.hAdd Nat Nat Nat (instHAdd Nat instAddNat) x y" let source := "λ x y: Nat => HAdd.hAdd Nat Nat Nat (instHAdd Nat instAddNat) x y"
let s := syntax_from_str env source |>.toOption |>.get! let s := syntax_from_str env source |>.toOption |>.get!
let expr := (← runTermElabMInMeta <| syntax_to_expr s) |>.toOption |>.get! let _expr := (← runTermElabMInMeta <| syntax_to_expr s) |>.toOption |>.get!
return LSpec.TestSeq.done return LSpec.TestSeq.done
runMetaMSeq env metaM runMetaMSeq env metaM