feat: remove unused scope variables
This commit is contained in:
parent
a703610347
commit
628be67e66
2 changed files with 42 additions and 10 deletions
|
|
@ -270,14 +270,13 @@ private def getResultingUniverse (ref : Syntax) : List InductiveType → TermEla
|
|||
| Expr.sort u _ => pure u
|
||||
| _ => Term.throwError ref "unexpected inductive type resulting type"
|
||||
|
||||
private def tmpIndParam := mkLevelParam `_tmp_ind_univ_param
|
||||
def tmpIndParam := mkLevelParam `_tmp_ind_univ_param
|
||||
|
||||
/--
|
||||
Return true if the resulting universe level is of the form `?m + k`.
|
||||
Return false if the resulting universe level does not contain universe metavariables.
|
||||
Throw exeception otherwise. -/
|
||||
private def shouldInferResultUniverse (ref : Syntax) (indTypes : List InductiveType) : TermElabM Bool := do
|
||||
u ← getResultingUniverse ref indTypes;
|
||||
Return true if `u` is of the form `?m + k`.
|
||||
Return false if `u` does not contain universe metavariables.
|
||||
Throw exception otherwise. -/
|
||||
def shouldInferResultUniverse (ref : Syntax) (u : Level) : TermElabM Bool := do
|
||||
u ← Term.instantiateLevelMVars ref u;
|
||||
if u.hasMVar then
|
||||
match u.getLevelOffset with
|
||||
|
|
@ -449,7 +448,8 @@ adaptReader (fun (ctx : Term.Context) => { ctx with levelNames := allUserLevelNa
|
|||
[];
|
||||
let indTypes := indTypes.reverse;
|
||||
Term.synthesizeSyntheticMVars false; -- resolve pending
|
||||
inferLevel ← shouldInferResultUniverse ref indTypes;
|
||||
u ← getResultingUniverse ref indTypes;
|
||||
inferLevel ← shouldInferResultUniverse ref u;
|
||||
withUsed ref vars indTypes $ fun vars => do
|
||||
let numParams := vars.size + numExplicitParams;
|
||||
indTypes ← updateParams ref vars indTypes;
|
||||
|
|
|
|||
|
|
@ -254,13 +254,45 @@ private partial def withFields {α} (views : Array StructFieldView) : Nat → Ar
|
|||
else
|
||||
k infos
|
||||
|
||||
private def getResultUniverse (ref : Syntax) (type : Expr) : TermElabM Level := do
|
||||
type ← Term.whnf ref type;
|
||||
match type with
|
||||
| Expr.sort u _ => pure u
|
||||
| _ => Term.throwError ref "unexpected structure resulting type"
|
||||
|
||||
private def removeUnused (ref : Syntax) (scopeVars : Array Expr) (params : Array Expr) (fieldInfos : Array StructFieldInfo)
|
||||
: TermElabM (LocalContext × LocalInstances × Array Expr) := do
|
||||
used ← params.foldlM (Term.collectUsedFVars ref) {};
|
||||
used ← fieldInfos.foldlM
|
||||
(fun (used : CollectFVars.State) info => do
|
||||
fvarType ← Term.inferType ref info.fvar;
|
||||
used ← Term.collectUsedFVars ref used fvarType;
|
||||
match info.value? with
|
||||
| none => pure used
|
||||
| some value => Term.collectUsedFVars ref used value)
|
||||
used;
|
||||
Term.removeUnused ref scopeVars used
|
||||
|
||||
private def withUsed {α} (ref : Syntax) (scopeVars : Array Expr) (params : Array Expr) (fieldInfos : Array StructFieldInfo) (k : Array Expr → TermElabM α)
|
||||
: TermElabM α := do
|
||||
(lctx, localInsts, vars) ← removeUnused ref scopeVars params fieldInfos;
|
||||
Term.withLCtx lctx localInsts $ k vars
|
||||
|
||||
private def elabStructureView (view : StructView) : TermElabM ElabStructResult := do
|
||||
let numExplicitParams := view.params.size;
|
||||
type ← Term.elabType view.type;
|
||||
unless (validStructType type) $ Term.throwError view.type "expected Type";
|
||||
let ref := view.ref;
|
||||
withParents view 0 #[] fun fieldInfos =>
|
||||
withFields view.fields 0 fieldInfos fun fieldInfos =>
|
||||
-- TODO
|
||||
Term.throwError view.ref "WIP"
|
||||
withFields view.fields 0 fieldInfos fun fieldInfos => do
|
||||
Term.synthesizeSyntheticMVars false; -- resolve pending
|
||||
u ← getResultUniverse ref type;
|
||||
inferLevel ← shouldInferResultUniverse ref u;
|
||||
withUsed ref view.scopeVars view.params fieldInfos $ fun scopeVars => do
|
||||
let numParams := scopeVars.size + numExplicitParams;
|
||||
|
||||
-- TODO
|
||||
Term.throwError view.ref ("WIP " ++ toString scopeVars)
|
||||
|
||||
/-
|
||||
parser! (structureTk <|> classTk) >> declId >> many Term.bracketedBinder >> optional «extends» >> Term.optType >> " := " >> optional structCtor >> structFields
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue