128 lines
5.1 KiB
Text
128 lines
5.1 KiB
Text
/-
|
||
Copyright (c) 2019 Microsoft Corporation. All rights reserved.
|
||
Released under Apache 2.0 license as described in the file LICENSE.
|
||
Authors: Leonardo de Moura, Sebastian Ullrich
|
||
-/
|
||
import Lean.Elab.Import
|
||
import Lean.Elab.Command
|
||
import Lean.Util.Profile
|
||
import Lean.Server.References
|
||
|
||
namespace Lean.Elab.Frontend
|
||
|
||
structure State where
|
||
commandState : Command.State
|
||
parserState : Parser.ModuleParserState
|
||
cmdPos : String.Pos
|
||
commands : Array Syntax := #[]
|
||
|
||
structure Context where
|
||
inputCtx : Parser.InputContext
|
||
|
||
abbrev FrontendM := ReaderT Context $ StateRefT State IO
|
||
|
||
def setCommandState (commandState : Command.State) : FrontendM Unit :=
|
||
modify fun s => { s with commandState := commandState }
|
||
|
||
@[inline] def runCommandElabM (x : Command.CommandElabM α) : FrontendM α := do
|
||
let ctx ← read
|
||
let s ← get
|
||
let cmdCtx : Command.Context := {
|
||
cmdPos := s.cmdPos
|
||
fileName := ctx.inputCtx.fileName
|
||
fileMap := ctx.inputCtx.fileMap
|
||
tacticCache? := none
|
||
}
|
||
match (← liftM <| EIO.toIO' <| (x cmdCtx).run s.commandState) with
|
||
| Except.error e => throw <| IO.Error.userError s!"unexpected internal error: {← e.toMessageData.toString}"
|
||
| Except.ok (a, sNew) => setCommandState sNew; return a
|
||
|
||
def elabCommandAtFrontend (stx : Syntax) : FrontendM Unit := do
|
||
runCommandElabM do
|
||
Command.elabCommandTopLevel stx
|
||
|
||
def updateCmdPos : FrontendM Unit := do
|
||
modify fun s => { s with cmdPos := s.parserState.pos }
|
||
|
||
def getParserState : FrontendM Parser.ModuleParserState := do pure (← get).parserState
|
||
def getCommandState : FrontendM Command.State := do pure (← get).commandState
|
||
def setParserState (ps : Parser.ModuleParserState) : FrontendM Unit := modify fun s => { s with parserState := ps }
|
||
def setMessages (msgs : MessageLog) : FrontendM Unit := modify fun s => { s with commandState := { s.commandState with messages := msgs } }
|
||
def getInputContext : FrontendM Parser.InputContext := do pure (← read).inputCtx
|
||
|
||
def processCommand : FrontendM Bool := do
|
||
updateCmdPos
|
||
let cmdState ← getCommandState
|
||
let ictx ← getInputContext
|
||
let pstate ← getParserState
|
||
let scope := cmdState.scopes.head!
|
||
let pmctx := { env := cmdState.env, options := scope.opts, currNamespace := scope.currNamespace, openDecls := scope.openDecls }
|
||
match profileit "parsing" scope.opts fun _ => Parser.parseCommand ictx pmctx pstate cmdState.messages with
|
||
| (cmd, ps, messages) =>
|
||
modify fun s => { s with commands := s.commands.push cmd }
|
||
setParserState ps
|
||
setMessages messages
|
||
if Parser.isEOI cmd || Parser.isExitCommand cmd then
|
||
pure true -- Done
|
||
else
|
||
profileitM IO.Error "elaboration" scope.opts <| elabCommandAtFrontend cmd
|
||
pure false
|
||
|
||
partial def processCommands : FrontendM Unit := do
|
||
let done ← processCommand
|
||
unless done do
|
||
processCommands
|
||
|
||
end Frontend
|
||
|
||
open Frontend
|
||
|
||
def IO.processCommands (inputCtx : Parser.InputContext) (parserState : Parser.ModuleParserState) (commandState : Command.State) : IO State := do
|
||
let (_, s) ← (Frontend.processCommands.run { inputCtx := inputCtx }).run { commandState := commandState, parserState := parserState, cmdPos := parserState.pos }
|
||
pure s
|
||
|
||
def process (input : String) (env : Environment) (opts : Options) (fileName : Option String := none) : IO (Environment × MessageLog) := do
|
||
let fileName := fileName.getD "<input>"
|
||
let inputCtx := Parser.mkInputContext input fileName
|
||
let s ← IO.processCommands inputCtx { : Parser.ModuleParserState } (Command.mkState env {} opts)
|
||
pure (s.commandState.env, s.commandState.messages)
|
||
|
||
builtin_initialize
|
||
registerOption `printMessageEndPos { defValue := false, descr := "print end position of each message in addition to start position" }
|
||
registerTraceClass `Elab.info
|
||
|
||
def getPrintMessageEndPos (opts : Options) : Bool :=
|
||
opts.getBool `printMessageEndPos false
|
||
|
||
@[export lean_run_frontend]
|
||
def runFrontend
|
||
(input : String)
|
||
(opts : Options)
|
||
(fileName : String)
|
||
(mainModuleName : Name)
|
||
(trustLevel : UInt32 := 0)
|
||
(ileanFileName? : Option String := none)
|
||
: IO (Environment × Bool) := do
|
||
let inputCtx := Parser.mkInputContext input fileName
|
||
let (header, parserState, messages) ← Parser.parseHeader inputCtx
|
||
let (env, messages) ← processHeader header opts messages inputCtx trustLevel
|
||
let env := env.setMainModule mainModuleName
|
||
let mut commandState := Command.mkState env messages opts
|
||
|
||
if ileanFileName?.isSome then
|
||
-- Collect InfoTrees so we can later extract and export their info to the ilean file
|
||
commandState := { commandState with infoState.enabled := true }
|
||
|
||
let s ← IO.processCommands inputCtx parserState commandState
|
||
for msg in s.commandState.messages.toList do
|
||
IO.print (← msg.toString (includeEndPos := getPrintMessageEndPos opts))
|
||
|
||
if let some ileanFileName := ileanFileName? then
|
||
let trees := s.commandState.infoState.trees.toArray
|
||
let references := Lean.Server.findModuleRefs inputCtx.fileMap trees (localVars := false)
|
||
let ilean := { module := mainModuleName, references : Lean.Server.Ilean }
|
||
IO.FS.writeFile ileanFileName $ Json.compress $ toJson ilean
|
||
|
||
pure (s.commandState.env, !s.commandState.messages.hasErrors)
|
||
|
||
end Lean.Elab
|