feat: add runTermElabM

src/Init/Lean/Elab/Command.lean

@@ -95,6 +95,26 @@ stx.ifNode
     | none      => logError stx ("command '" ++ toString k ++ "' has not been implemented"))
   (fun _ => logErrorUsingCmdPos ("unexpected command"))
 
+@[specialize] def runTermElabM {α} (x : TermElabM α) : CommandElabM α :=
+fun ctx s =>
+  let scope := s.scopes.head!;
+  let termCtx : Term.Context := {
+    config         := { opts := scope.options, foApprox := true, ctxApprox := true, quasiPatternApprox := true, isDefEqStuckEx := true },
+    fileName       := ctx.fileName,
+    fileMap        := ctx.fileMap,
+    cmdPos         := s.cmdPos,
+    ns             := scope.ns,
+    univNames      := scope.univNames,
+    openDecls      := scope.openDecls
+  };
+  let termState : Term.State := {
+    env      := s.env,
+    messages := s.messages
+  };
+  match x termCtx termState with
+  | EStateM.Result.ok a newS     => EStateM.Result.ok a { env := newS.env, messages := newS.messages, .. s }
+  | EStateM.Result.error ex newS => EStateM.Result.error ex { env := newS.env, messages := newS.messages, .. s }
+
 def getEnv : CommandElabM Environment :=
 do s ← get; pure s.env
 

src/Init/Lean/Elab/Term.lean

@@ -18,6 +18,7 @@ structure Context extends Meta.Context :=
 (fileMap     : FileMap)
 (cmdPos      : String.Pos)
 (ns          : Name) -- current Namespace
+(univNames   : List Name := [])
 (openDecls   : List OpenDecl := [])
 
 inductive SyntheticMVarInfo
@@ -80,7 +81,7 @@ abbrev TermElabAttribute := ElabAttribute TermElabTable
 def mkTermElabAttribute : IO TermElabAttribute := mkElabAttribute `elabTerm "term" builtinTermElabTable
 @[init mkTermElabAttribute] constant termElabAttribute : TermElabAttribute := arbitrary _
 
-@[inline] def liftMetaM {α} (x : Meta.MetaM α) : TermElabM α :=
+@[inline] def liftMetaM {α} (x : MetaM α) : TermElabM α :=
 fun ctx s => match x ctx.toContext s.toState with
   | EStateM.Result.ok a newS     => EStateM.Result.ok a { toState := newS, .. s }
   | EStateM.Result.error ex newS => EStateM.Result.error (Exception.meta ex) { toState := newS, .. s }
@@ -88,6 +89,9 @@ fun ctx s => match x ctx.toContext s.toState with
 def isDefEq (t s : Expr) : TermElabM Bool := liftMetaM $ Meta.isDefEq t s
 def inferType (e : Expr) : TermElabM Expr := liftMetaM $ Meta.inferType e
 def whnf (e : Expr) : TermElabM Expr := liftMetaM $ Meta.whnf e
+def mkFreshLevelMVar : TermElabM Level := liftMetaM $ Meta.mkFreshLevelMVar
+def mkFreshExprMVar (type : Expr) (userName? : Name := Name.anonymous) (synthetic : Bool := false) : TermElabM Expr :=
+liftMetaM $ Meta.mkFreshExprMVar type userName? synthetic
 
 def elabTerm (stx : Syntax) (expectedType : Option Expr) : TermElabM Expr :=
 stx.ifNode
@@ -100,8 +104,14 @@ stx.ifNode
     | none      => throw $ Exception.other ("elaboration function for '" ++ toString k ++ "' has not been implemented"))
   (fun _ => throw $ Exception.other "term elaborator failed, unexpected syntax")
 
+def elabType (stx : Syntax) : TermElabM Expr :=
+do u ← mkFreshLevelMVar;
+   elabTerm stx (mkSort u)
+
 end Term
 
+export Term (TermElabM)
+
 /-
 partial def elabTermAux : Syntax Expr → Option Expr → Bool → Elab (Syntax Expr)
 | stx, expectedType, expanding => stx.ifNode

src/Init/Lean/Meta.lean

@@ -17,3 +17,7 @@ import Init.Lean.Meta.AbstractMVars
 import Init.Lean.Meta.SynthInstance
 import Init.Lean.Meta.AppBuilder
 import Init.Lean.Meta.Tactic
+
+namespace Lean
+export Meta (MetaM)
+end Lean