lean4-htt/Lake/Load/Elab.lean
2022-07-22 04:46:44 -04:00

67 lines
2.5 KiB
Text

/-
Copyright (c) 2021 Mac Malone. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mac Malone
-/
import Lean.Elab.Frontend
import Lake.DSL.Extensions
import Lake.Load.Config
import Lake.Util.Log
namespace Lake
open Lean System
deriving instance BEq, Hashable for Import
/- Cache for the imported header environment of Lake configuration files. -/
initialize importEnvCache : IO.Ref (Std.HashMap (List Import) Environment) ← IO.mkRef {}
/-- Like `Lean.Elab.processHeader`, but using `importEnvCache`. -/
def processHeader (header : Syntax) (opts : Options) (trustLevel : UInt32)
(inputCtx : Parser.InputContext) : StateT MessageLog IO Environment := do
try
let imports := Elab.headerToImports header
if let some env := (← importEnvCache.get).find? imports then
return env
let env ← importModules imports opts trustLevel
importEnvCache.modify (·.insert imports env)
return env
catch e =>
let pos := inputCtx.fileMap.toPosition <| header.getPos?.getD 0
modify (·.add { fileName := inputCtx.fileName, data := toString e, pos })
mkEmptyEnvironment
/-- Main module `Name` of a Lake configuration file. -/
def configModuleName : Name := `lakefile
/-- Elaborate `configFile` with the given package directory and options. -/
def elabConfigFile (pkgDir : FilePath) (configOpts : NameMap String)
(leanOpts := Options.empty) (configFile := pkgDir / defaultConfigFile) : LogIO Environment := do
-- Read file and initialize environment
let input ← IO.FS.readFile configFile
let inputCtx := Parser.mkInputContext input configFile.toString
let (header, parserState, messages) ← Parser.parseHeader inputCtx
let (env, messages) ← processHeader header leanOpts 1024 inputCtx messages
let env := env.setMainModule configModuleName
-- Configure extensions
let env := dirExt.setState env pkgDir
let env := optsExt.setState env configOpts
-- Elaborate File
let commandState := Elab.Command.mkState env messages leanOpts
let s ← Elab.IO.processCommands inputCtx parserState commandState
-- Log messages
for msg in s.commandState.messages.toList do
match msg.severity with
| MessageSeverity.information => logInfo (← msg.toString)
| MessageSeverity.warning => logWarning (← msg.toString)
| MessageSeverity.error => logError (← msg.toString)
-- Check result
if s.commandState.messages.hasErrors then
error s!"{configFile}: package configuration has errors"
else
return s.commandState.env