Add expression sexp printing (1/2, tests pending)
This commit is contained in:
parent
d705cdf0e5
commit
19c57ada1e
33
Main.lean
33
Main.lean
|
@ -19,6 +19,36 @@ unsafe def loop : Subroutine Unit := do
|
||||||
IO.println <| toString <| ret
|
IO.println <| toString <| ret
|
||||||
loop
|
loop
|
||||||
|
|
||||||
|
namespace Lean
|
||||||
|
|
||||||
|
/-- This is better than the default version since it handles `.` and doesn't
|
||||||
|
crash the program when it fails. -/
|
||||||
|
def setOptionFromString' (opts : Options) (entry : String) : ExceptT String IO Options := do
|
||||||
|
let ps := (entry.splitOn "=").map String.trim
|
||||||
|
let [key, val] ← pure ps | throw "invalid configuration option entry, it must be of the form '<key> = <value>'"
|
||||||
|
let key := Pantograph.str_to_name key
|
||||||
|
let defValue ← getOptionDefaultValue key
|
||||||
|
match defValue with
|
||||||
|
| DataValue.ofString _ => pure $ opts.setString key val
|
||||||
|
| DataValue.ofBool _ =>
|
||||||
|
match val with
|
||||||
|
| "true" => pure $ opts.setBool key true
|
||||||
|
| "false" => pure $ opts.setBool key false
|
||||||
|
| _ => throw s!"invalid Bool option value '{val}'"
|
||||||
|
| DataValue.ofName _ => pure $ opts.setName key val.toName
|
||||||
|
| DataValue.ofNat _ =>
|
||||||
|
match val.toNat? with
|
||||||
|
| none => throw s!"invalid Nat option value '{val}'"
|
||||||
|
| some v => pure $ opts.setNat key v
|
||||||
|
| DataValue.ofInt _ =>
|
||||||
|
match val.toInt? with
|
||||||
|
| none => throw s!"invalid Int option value '{val}'"
|
||||||
|
| some v => pure $ opts.setInt key v
|
||||||
|
| DataValue.ofSyntax _ => throw s!"invalid Syntax option value"
|
||||||
|
|
||||||
|
end Lean
|
||||||
|
|
||||||
|
|
||||||
unsafe def main (args: List String): IO Unit := do
|
unsafe def main (args: List String): IO Unit := do
|
||||||
-- NOTE: A more sophisticated scheme of command line argument handling is needed.
|
-- NOTE: A more sophisticated scheme of command line argument handling is needed.
|
||||||
-- Separate imports and options
|
-- Separate imports and options
|
||||||
|
@ -30,7 +60,7 @@ unsafe def main (args: List String): IO Unit := do
|
||||||
Lean.initSearchPath (← Lean.findSysroot)
|
Lean.initSearchPath (← Lean.findSysroot)
|
||||||
|
|
||||||
let options? ← args.filterMap (λ s => if s.startsWith "--" then .some <| s.drop 2 else .none)
|
let options? ← args.filterMap (λ s => if s.startsWith "--" then .some <| s.drop 2 else .none)
|
||||||
|>.foldlM Lean.setOptionFromString'' Lean.Options.empty
|
|>.foldlM Lean.setOptionFromString' Lean.Options.empty
|
||||||
|>.run
|
|>.run
|
||||||
let options ← match options? with
|
let options ← match options? with
|
||||||
| .ok options => pure options
|
| .ok options => pure options
|
||||||
|
@ -42,6 +72,7 @@ unsafe def main (args: List String): IO Unit := do
|
||||||
(opts := {})
|
(opts := {})
|
||||||
(trustLevel := 1)
|
(trustLevel := 1)
|
||||||
let context: Context := {
|
let context: Context := {
|
||||||
|
imports
|
||||||
}
|
}
|
||||||
let coreContext: Lean.Core.Context := {
|
let coreContext: Lean.Core.Context := {
|
||||||
currNamespace := Lean.Name.str .anonymous "Aniva"
|
currNamespace := Lean.Name.str .anonymous "Aniva"
|
||||||
|
|
|
@ -3,39 +3,14 @@ import Pantograph.Serial
|
||||||
import Pantograph.Meta
|
import Pantograph.Meta
|
||||||
import Pantograph.Symbols
|
import Pantograph.Symbols
|
||||||
|
|
||||||
namespace Lean
|
|
||||||
-- This is better than the default version since it handles `.` and doesn't
|
|
||||||
-- crash the program when it fails.
|
|
||||||
def setOptionFromString'' (opts : Options) (entry : String) : ExceptT String IO Options := do
|
|
||||||
let ps := (entry.splitOn "=").map String.trim
|
|
||||||
let [key, val] ← pure ps | throw "invalid configuration option entry, it must be of the form '<key> = <value>'"
|
|
||||||
let key := Pantograph.str_to_name key
|
|
||||||
let defValue ← getOptionDefaultValue key
|
|
||||||
match defValue with
|
|
||||||
| DataValue.ofString _ => pure $ opts.setString key val
|
|
||||||
| DataValue.ofBool _ =>
|
|
||||||
match val with
|
|
||||||
| "true" => pure $ opts.setBool key true
|
|
||||||
| "false" => pure $ opts.setBool key false
|
|
||||||
| _ => throw s!"invalid Bool option value '{val}'"
|
|
||||||
| DataValue.ofName _ => pure $ opts.setName key val.toName
|
|
||||||
| DataValue.ofNat _ =>
|
|
||||||
match val.toNat? with
|
|
||||||
| none => throw s!"invalid Nat option value '{val}'"
|
|
||||||
| some v => pure $ opts.setNat key v
|
|
||||||
| DataValue.ofInt _ =>
|
|
||||||
match val.toInt? with
|
|
||||||
| none => throw s!"invalid Int option value '{val}'"
|
|
||||||
| some v => pure $ opts.setInt key v
|
|
||||||
| DataValue.ofSyntax _ => throw s!"invalid Syntax option value"
|
|
||||||
end Lean
|
|
||||||
|
|
||||||
namespace Pantograph
|
namespace Pantograph
|
||||||
|
|
||||||
structure Context where
|
structure Context where
|
||||||
|
imports: List String
|
||||||
|
|
||||||
/-- Stores state of the REPL -/
|
/-- Stores state of the REPL -/
|
||||||
structure State where
|
structure State where
|
||||||
|
options: Commands.Options := {}
|
||||||
--environments: Array Lean.Environment := #[]
|
--environments: Array Lean.Environment := #[]
|
||||||
proofTrees: Array ProofTree := #[]
|
proofTrees: Array ProofTree := #[]
|
||||||
|
|
||||||
|
@ -59,9 +34,13 @@ def parse_command (s: String): Except String Commands.Command := do
|
||||||
|
|
||||||
def execute (command: Commands.Command): Subroutine Lean.Json := do
|
def execute (command: Commands.Command): Subroutine Lean.Json := do
|
||||||
match command.cmd with
|
match command.cmd with
|
||||||
| "option.set" =>
|
| "options.set" =>
|
||||||
match Lean.fromJson? command.payload with
|
match Lean.fromJson? command.payload with
|
||||||
| .ok args => option_set args
|
| .ok args => options_set args
|
||||||
|
| .error x => return errorJson x
|
||||||
|
| "options.print" =>
|
||||||
|
match Lean.fromJson? command.payload with
|
||||||
|
| .ok args => options_print args
|
||||||
| .error x => return errorJson x
|
| .error x => return errorJson x
|
||||||
| "catalog" =>
|
| "catalog" =>
|
||||||
match Lean.fromJson? command.payload with
|
match Lean.fromJson? command.payload with
|
||||||
|
@ -97,16 +76,19 @@ def execute (command: Commands.Command): Subroutine Lean.Json := do
|
||||||
{ error := type, desc := desc }: Commands.InteractionError)
|
{ error := type, desc := desc }: Commands.InteractionError)
|
||||||
errorJson := errorI "json"
|
errorJson := errorI "json"
|
||||||
errorIndex := errorI "index"
|
errorIndex := errorI "index"
|
||||||
option_set (args: Commands.OptionSet): Subroutine Lean.Json := do
|
-- Command Functions
|
||||||
let options? ← args.options.foldlM Lean.setOptionFromString'' Lean.Options.empty
|
options_set (args: Commands.OptionsSet): Subroutine Lean.Json := do
|
||||||
|>.run
|
let state ← get
|
||||||
match options? with
|
set { state with
|
||||||
| .ok options =>
|
options := {
|
||||||
withTheReader Lean.Core.Context
|
printExprPretty := args.printExprPretty?.getD true,
|
||||||
(λ coreContext => { coreContext with options })
|
printExprAST := args.printExprAST?.getD true,
|
||||||
(pure $ Lean.toJson <| ({ }: Commands.OptionSetResult))
|
proofVariableDelta := args.proofVariableDelta?.getD false
|
||||||
| .error e =>
|
}
|
||||||
return errorI "parsing" e
|
}
|
||||||
|
return Lean.toJson ({ }: Commands.OptionsSetResult)
|
||||||
|
options_print (_: Commands.OptionsPrint): Subroutine Lean.Json := do
|
||||||
|
return Lean.toJson (← get).options
|
||||||
catalog (_: Commands.Catalog): Subroutine Lean.Json := do
|
catalog (_: Commands.Catalog): Subroutine Lean.Json := do
|
||||||
let env ← Lean.MonadEnv.getEnv
|
let env ← Lean.MonadEnv.getEnv
|
||||||
let names := env.constants.fold (init := #[]) (λ acc name info =>
|
let names := env.constants.fold (init := #[]) (λ acc name info =>
|
||||||
|
@ -115,22 +97,23 @@ def execute (command: Commands.Command): Subroutine Lean.Json := do
|
||||||
| .none => acc)
|
| .none => acc)
|
||||||
return Lean.toJson <| ({ symbols := names }: Commands.CatalogResult)
|
return Lean.toJson <| ({ symbols := names }: Commands.CatalogResult)
|
||||||
inspect (args: Commands.Inspect): Subroutine Lean.Json := do
|
inspect (args: Commands.Inspect): Subroutine Lean.Json := do
|
||||||
|
let state ← get
|
||||||
let env ← Lean.MonadEnv.getEnv
|
let env ← Lean.MonadEnv.getEnv
|
||||||
let name := str_to_name args.name
|
let name := str_to_name args.name
|
||||||
let info? := env.find? name
|
let info? := env.find? name
|
||||||
match info? with
|
match info? with
|
||||||
| none => return errorIndex s!"Symbol not found {args.name}"
|
| none => return errorIndex s!"Symbol not found {args.name}"
|
||||||
| some info =>
|
| some info =>
|
||||||
let format ← Lean.Meta.ppExpr info.toConstantVal.type
|
|
||||||
let module? := env.getModuleIdxFor? name >>=
|
let module? := env.getModuleIdxFor? name >>=
|
||||||
(λ idx => env.allImportedModuleNames.get? idx.toNat) |>.map toString
|
(λ idx => env.allImportedModuleNames.get? idx.toNat) |>.map toString
|
||||||
let boundExpr? ← (match info.toConstantVal.type with
|
let value? := match args.value?, info with
|
||||||
| .forallE _ _ _ _ => return Option.none -- TODO: Temporary override, enable expression dissection in options.
|
| .some true, _ => info.value?
|
||||||
-- return .some (← type_expr_to_bound info.toConstantVal.type)
|
| .some false, _ => .none
|
||||||
| _ => return Option.none)
|
| .none, .defnInfo _ => info.value?
|
||||||
|
| .none, _ => .none
|
||||||
return Lean.toJson ({
|
return Lean.toJson ({
|
||||||
type := toString format,
|
type := ← serialize_expression state.options info.type,
|
||||||
boundExpr? := boundExpr?,
|
value? := ← value?.mapM (λ v => serialize_expression state.options v),
|
||||||
module? := module?
|
module? := module?
|
||||||
}: Commands.InspectResult)
|
}: Commands.InspectResult)
|
||||||
clear : Subroutine Lean.Json := do
|
clear : Subroutine Lean.Json := do
|
||||||
|
|
|
@ -6,10 +6,55 @@ its field names to avoid confusion with error messages generated by the REPL.
|
||||||
-/
|
-/
|
||||||
import Lean.Data.Json
|
import Lean.Data.Json
|
||||||
|
|
||||||
import Pantograph.Serial
|
|
||||||
|
|
||||||
namespace Pantograph.Commands
|
namespace Pantograph.Commands
|
||||||
|
|
||||||
|
|
||||||
|
/-- Main Option structure, placed here to avoid name collision -/
|
||||||
|
structure Options where
|
||||||
|
-- When enabled, pretty print every expression
|
||||||
|
printExprPretty: Bool := true
|
||||||
|
-- When enabled, print the raw AST of expressions
|
||||||
|
printExprAST: Bool := false
|
||||||
|
-- When enabled, the types and values of persistent variables in a proof goal
|
||||||
|
-- are not shown unless they are new to the proof step. Reduces overhead
|
||||||
|
proofVariableDelta: Bool := false
|
||||||
|
deriving Lean.ToJson
|
||||||
|
|
||||||
|
--- Expression Objects ---
|
||||||
|
|
||||||
|
structure BoundExpression where
|
||||||
|
binders: Array (String × String)
|
||||||
|
target: String
|
||||||
|
deriving Lean.ToJson
|
||||||
|
structure Expression where
|
||||||
|
-- Pretty printed expression
|
||||||
|
pp?: Option String := .none
|
||||||
|
-- AST structure
|
||||||
|
sexp?: Option String := .none
|
||||||
|
deriving Lean.ToJson
|
||||||
|
|
||||||
|
structure Variable where
|
||||||
|
name: String
|
||||||
|
/-- Does the name contain a dagger -/
|
||||||
|
isInaccessible: Bool := false
|
||||||
|
type: Expression
|
||||||
|
value?: Option Expression := .none
|
||||||
|
deriving Lean.ToJson
|
||||||
|
structure Goal where
|
||||||
|
/-- String case id -/
|
||||||
|
caseName?: Option String := .none
|
||||||
|
/-- Is the goal in conversion mode -/
|
||||||
|
isConversion: Bool := false
|
||||||
|
/-- target expression type -/
|
||||||
|
target: Expression
|
||||||
|
/-- Variables -/
|
||||||
|
vars: Array Variable := #[]
|
||||||
|
deriving Lean.ToJson
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
--- Individual Commands and return types ---
|
||||||
|
|
||||||
structure Command where
|
structure Command where
|
||||||
cmd: String
|
cmd: String
|
||||||
payload: Lean.Json
|
payload: Lean.Json
|
||||||
|
@ -23,15 +68,19 @@ structure InteractionError where
|
||||||
|
|
||||||
--- Individual command and return types ---
|
--- Individual command and return types ---
|
||||||
|
|
||||||
-- Set Lean options supplied in the form of
|
/-- Set options; See `Options` struct above for meanings -/
|
||||||
--
|
structure OptionsSet where
|
||||||
-- option=value
|
printExprPretty?: Option Bool
|
||||||
structure OptionSet where
|
printExprAST?: Option Bool
|
||||||
options: Array String
|
proofVariableDelta?: Option Bool
|
||||||
deriving Lean.FromJson
|
deriving Lean.FromJson
|
||||||
structure OptionSetResult where
|
structure OptionsSetResult where
|
||||||
deriving Lean.ToJson
|
deriving Lean.ToJson
|
||||||
|
|
||||||
|
structure OptionsPrint where
|
||||||
|
deriving Lean.FromJson
|
||||||
|
abbrev OptionsPrintResult := Options
|
||||||
|
|
||||||
|
|
||||||
-- Print all symbols in environment
|
-- Print all symbols in environment
|
||||||
structure Catalog where
|
structure Catalog where
|
||||||
|
@ -43,11 +92,13 @@ structure CatalogResult where
|
||||||
-- Print the type of a symbol
|
-- Print the type of a symbol
|
||||||
structure Inspect where
|
structure Inspect where
|
||||||
name: String
|
name: String
|
||||||
|
-- If true/false, show/hide the value expressions; By default definitions
|
||||||
|
-- values are shown and theorem values are hidden.
|
||||||
|
value?: Option Bool := .some false
|
||||||
deriving Lean.FromJson
|
deriving Lean.FromJson
|
||||||
structure InspectResult where
|
structure InspectResult where
|
||||||
type: String
|
type: Expression
|
||||||
-- Decompose the bound expression when the type is forall.
|
value?: Option Expression := .none
|
||||||
boundExpr?: Option BoundExpression := Option.none
|
|
||||||
module?: Option String
|
module?: Option String
|
||||||
deriving Lean.ToJson
|
deriving Lean.ToJson
|
||||||
|
|
||||||
|
|
|
@ -16,7 +16,9 @@ From this point on, any proof which extends
|
||||||
-/
|
-/
|
||||||
|
|
||||||
def Lean.MessageLog.getErrorMessages (log : MessageLog) : MessageLog :=
|
def Lean.MessageLog.getErrorMessages (log : MessageLog) : MessageLog :=
|
||||||
{ msgs := log.msgs.filter fun m => match m.severity with | MessageSeverity.error => true | _ => false }
|
{
|
||||||
|
msgs := log.msgs.filter fun m => match m.severity with | MessageSeverity.error => true | _ => false
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
namespace Pantograph
|
namespace Pantograph
|
||||||
|
@ -83,12 +85,14 @@ inductive TacticResult where
|
||||||
-- Invalid id
|
-- Invalid id
|
||||||
| invalid (message: String): TacticResult
|
| invalid (message: String): TacticResult
|
||||||
-- Goes to next state
|
-- Goes to next state
|
||||||
| success (nextId?: Option Nat) (goals: Array Goal)
|
| success (nextId?: Option Nat) (goals: Array Commands.Goal)
|
||||||
-- Fails with messages
|
-- Fails with messages
|
||||||
| failure (messages: Array String)
|
| failure (messages: Array String)
|
||||||
|
|
||||||
/-- Execute tactic on given state -/
|
/-- Execute tactic on given state -/
|
||||||
def ProofTree.execute (stateId: Nat) (goalId: Nat) (tactic: String): StateRefT ProofTree M TacticResult := do
|
def ProofTree.execute (stateId: Nat) (goalId: Nat) (tactic: String): StateRefT ProofTree M TacticResult := do
|
||||||
|
-- TODO: Replace with actual options
|
||||||
|
let options: Commands.Options := {}
|
||||||
let tree ← get
|
let tree ← get
|
||||||
match tree.states.get? stateId with
|
match tree.states.get? stateId with
|
||||||
| .none => return .invalid s!"Invalid state id {stateId}"
|
| .none => return .invalid s!"Invalid state id {stateId}"
|
||||||
|
@ -113,7 +117,7 @@ def ProofTree.execute (stateId: Nat) (goalId: Nat) (tactic: String): StateRefT P
|
||||||
modify fun s => { s with states := s.states.push proofState }
|
modify fun s => { s with states := s.states.push proofState }
|
||||||
let goals ← nextGoals.mapM fun mvarId => do
|
let goals ← nextGoals.mapM fun mvarId => do
|
||||||
match (← MonadMCtx.getMCtx).findDecl? mvarId with
|
match (← MonadMCtx.getMCtx).findDecl? mvarId with
|
||||||
| .some mvarDecl => serialize_goal mvarDecl
|
| .some mvarDecl => serialize_goal options mvarDecl
|
||||||
| .none => throwError mvarId
|
| .none => throwError mvarId
|
||||||
return .success (.some nextId) goals.toArray
|
return .success (.some nextId) goals.toArray
|
||||||
|
|
||||||
|
|
|
@ -3,15 +3,20 @@ All serialisation functions
|
||||||
-/
|
-/
|
||||||
import Lean
|
import Lean
|
||||||
|
|
||||||
|
import Pantograph.Commands
|
||||||
|
|
||||||
namespace Pantograph
|
namespace Pantograph
|
||||||
open Lean
|
open Lean
|
||||||
|
|
||||||
|
--- Input Functions ---
|
||||||
|
|
||||||
|
|
||||||
/-- Read a theorem from the environment -/
|
/-- Read a theorem from the environment -/
|
||||||
def expr_from_const (env: Environment) (name: Name): Except String Lean.Expr :=
|
def expr_from_const (env: Environment) (name: Name): Except String Lean.Expr :=
|
||||||
match env.find? name with
|
match env.find? name with
|
||||||
| none => throw s!"Symbol not found: {name}"
|
| none => throw s!"Symbol not found: {name}"
|
||||||
| some cInfo => return cInfo.type
|
| some cInfo => return cInfo.type
|
||||||
|
/-- Read syntax object from string -/
|
||||||
def syntax_from_str (env: Environment) (s: String): Except String Syntax :=
|
def syntax_from_str (env: Environment) (s: String): Except String Syntax :=
|
||||||
Parser.runParserCategory
|
Parser.runParserCategory
|
||||||
(env := env)
|
(env := env)
|
||||||
|
@ -39,84 +44,15 @@ def syntax_to_expr (syn: Syntax): Elab.TermElabM (Except String Expr) := do
|
||||||
return .ok expr
|
return .ok expr
|
||||||
catch ex => return .error (← ex.toMessageData.toString)
|
catch ex => return .error (← ex.toMessageData.toString)
|
||||||
|
|
||||||
structure BoundExpression where
|
|
||||||
binders: Array (String × String)
|
--- Output Functions ---
|
||||||
target: String
|
|
||||||
deriving ToJson
|
def type_expr_to_bound (expr: Expr): MetaM Commands.BoundExpression := do
|
||||||
def type_expr_to_bound (expr: Expr): MetaM BoundExpression := do
|
|
||||||
Meta.forallTelescope expr fun arr body => do
|
Meta.forallTelescope expr fun arr body => do
|
||||||
let binders ← arr.mapM fun fvar => do
|
let binders ← arr.mapM fun fvar => do
|
||||||
return (toString (← fvar.fvarId!.getUserName), toString (← Meta.ppExpr (← fvar.fvarId!.getType)))
|
return (toString (← fvar.fvarId!.getUserName), toString (← Meta.ppExpr (← fvar.fvarId!.getType)))
|
||||||
return { binders, target := toString (← Meta.ppExpr body) }
|
return { binders, target := toString (← Meta.ppExpr body) }
|
||||||
|
|
||||||
|
|
||||||
structure Variable where
|
|
||||||
name: String
|
|
||||||
/-- Does the name contain a dagger -/
|
|
||||||
isInaccessible: Bool := false
|
|
||||||
type: String
|
|
||||||
value?: Option String := .none
|
|
||||||
deriving ToJson
|
|
||||||
structure Goal where
|
|
||||||
/-- String case id -/
|
|
||||||
caseName?: Option String := .none
|
|
||||||
/-- Is the goal in conversion mode -/
|
|
||||||
isConversion: Bool := false
|
|
||||||
/-- target expression type -/
|
|
||||||
target: String
|
|
||||||
/-- Variables -/
|
|
||||||
vars: Array Variable := #[]
|
|
||||||
deriving ToJson
|
|
||||||
|
|
||||||
/-- Adapted from ppGoal -/
|
|
||||||
def serialize_goal (mvarDecl: MetavarDecl) : MetaM Goal := do
|
|
||||||
-- Options for printing; See Meta.ppGoal for details
|
|
||||||
let showLetValues := True
|
|
||||||
let ppAuxDecls := false
|
|
||||||
let ppImplDetailHyps := false
|
|
||||||
let lctx := mvarDecl.lctx
|
|
||||||
let lctx := lctx.sanitizeNames.run' { options := (← getOptions) }
|
|
||||||
Meta.withLCtx lctx mvarDecl.localInstances do
|
|
||||||
let rec ppVars (localDecl : LocalDecl) : MetaM Variable := do
|
|
||||||
match localDecl with
|
|
||||||
| .cdecl _ _ varName type _ _ =>
|
|
||||||
let varName := varName.simpMacroScopes
|
|
||||||
let type ← instantiateMVars type
|
|
||||||
return {
|
|
||||||
name := toString varName,
|
|
||||||
isInaccessible := varName.isInaccessibleUserName,
|
|
||||||
type := toString <| ← Meta.ppExpr type
|
|
||||||
}
|
|
||||||
| .ldecl _ _ varName type val _ _ => do
|
|
||||||
let varName := varName.simpMacroScopes
|
|
||||||
let type ← instantiateMVars type
|
|
||||||
let value? ← if showLetValues then
|
|
||||||
let val ← instantiateMVars val
|
|
||||||
pure $ .some <| toString <| (← Meta.ppExpr val)
|
|
||||||
else
|
|
||||||
pure $ .none
|
|
||||||
return {
|
|
||||||
name := toString varName,
|
|
||||||
isInaccessible := varName.isInaccessibleUserName,
|
|
||||||
type := toString <| ← Meta.ppExpr type
|
|
||||||
value? := value?
|
|
||||||
}
|
|
||||||
let vars ← lctx.foldlM (init := []) fun acc (localDecl : LocalDecl) => do
|
|
||||||
let skip := !ppAuxDecls && localDecl.isAuxDecl || !ppImplDetailHyps && localDecl.isImplementationDetail
|
|
||||||
if skip then
|
|
||||||
return acc
|
|
||||||
else
|
|
||||||
let var ← ppVars localDecl
|
|
||||||
return var::acc
|
|
||||||
return {
|
|
||||||
caseName? := match mvarDecl.userName with
|
|
||||||
| Name.anonymous => .none
|
|
||||||
| name => .some <| toString name,
|
|
||||||
isConversion := "| " == (Meta.getGoalPrefix mvarDecl)
|
|
||||||
target := toString <| (← Meta.ppExpr (← instantiateMVars mvarDecl.type)),
|
|
||||||
vars := vars.reverse.toArray
|
|
||||||
}
|
|
||||||
|
|
||||||
/-- Completely serialises an expression tree. Json not used due to compactness -/
|
/-- Completely serialises an expression tree. Json not used due to compactness -/
|
||||||
def serialize_expression_ast (expr: Expr): MetaM String := do
|
def serialize_expression_ast (expr: Expr): MetaM String := do
|
||||||
match expr with
|
match expr with
|
||||||
|
@ -131,16 +67,16 @@ def serialize_expression_ast (expr: Expr): MetaM String := do
|
||||||
| .const declName _ =>
|
| .const declName _ =>
|
||||||
-- The universe level of the const expression is elided since it should be
|
-- The universe level of the const expression is elided since it should be
|
||||||
-- inferrable from surrounding expression
|
-- inferrable from surrounding expression
|
||||||
return s!"(:const {declName})"
|
return s!"(:c {declName})"
|
||||||
| .app fn arg =>
|
| .app fn arg =>
|
||||||
let fn' ← serialize_expression_ast fn
|
let fn' ← serialize_expression_ast fn
|
||||||
let arg' ← serialize_expression_ast arg
|
let arg' ← serialize_expression_ast arg
|
||||||
return s!"(:app {fn'} {arg'})"
|
return s!"({fn'} {arg'})"
|
||||||
| .lam binderName binderType body binderInfo =>
|
| .lam binderName binderType body binderInfo =>
|
||||||
let binderType' ← serialize_expression_ast binderType
|
let binderType' ← serialize_expression_ast binderType
|
||||||
let body' ← serialize_expression_ast body
|
let body' ← serialize_expression_ast body
|
||||||
let binderInfo' := binderInfoToAst binderInfo
|
let binderInfo' := binderInfoToAst binderInfo
|
||||||
return s!"(:lam {binderName} {binderType'} {body'} :{binderInfo'})"
|
return s!"(:lambda {binderName} {binderType'} {body'} :{binderInfo'})"
|
||||||
| .forallE binderName binderType body binderInfo =>
|
| .forallE binderName binderType body binderInfo =>
|
||||||
let binderType' ← serialize_expression_ast binderType
|
let binderType' ← serialize_expression_ast binderType
|
||||||
let body' ← serialize_expression_ast body
|
let body' ← serialize_expression_ast body
|
||||||
|
@ -170,11 +106,69 @@ def serialize_expression_ast (expr: Expr): MetaM String := do
|
||||||
| .strictImplicit => "strictImplicit"
|
| .strictImplicit => "strictImplicit"
|
||||||
| .instImplicit => "instImplicit"
|
| .instImplicit => "instImplicit"
|
||||||
|
|
||||||
/-- Serialised expression object --/
|
def serialize_expression (options: Commands.Options) (e: Expr): MetaM Commands.Expression := do
|
||||||
structure Expression where
|
let pp := toString (← Meta.ppExpr e)
|
||||||
prettyprinted?: Option String := .none
|
let pp?: Option String := match options.printExprPretty with
|
||||||
bound?: Option BoundExpression := .none
|
| true => .some pp
|
||||||
sexp?: Option String := .none
|
| false => .none
|
||||||
deriving ToJson
|
let sexp: String := (← serialize_expression_ast e)
|
||||||
|
let sexp?: Option String := match options.printExprAST with
|
||||||
|
| true => .some sexp
|
||||||
|
| false => .none
|
||||||
|
return {
|
||||||
|
pp?,
|
||||||
|
sexp?
|
||||||
|
}
|
||||||
|
|
||||||
|
/-- Adapted from ppGoal -/
|
||||||
|
def serialize_goal (options: Commands.Options) (mvarDecl: MetavarDecl) : MetaM Commands.Goal := do
|
||||||
|
-- Options for printing; See Meta.ppGoal for details
|
||||||
|
let showLetValues := True
|
||||||
|
let ppAuxDecls := false
|
||||||
|
let ppImplDetailHyps := false
|
||||||
|
let lctx := mvarDecl.lctx
|
||||||
|
let lctx := lctx.sanitizeNames.run' { options := (← getOptions) }
|
||||||
|
Meta.withLCtx lctx mvarDecl.localInstances do
|
||||||
|
let rec ppVars (localDecl : LocalDecl) : MetaM Commands.Variable := do
|
||||||
|
match localDecl with
|
||||||
|
| .cdecl _ _ varName type _ _ =>
|
||||||
|
let varName := varName.simpMacroScopes
|
||||||
|
let type ← instantiateMVars type
|
||||||
|
return {
|
||||||
|
name := toString varName,
|
||||||
|
isInaccessible := varName.isInaccessibleUserName,
|
||||||
|
type := (← serialize_expression options type)
|
||||||
|
}
|
||||||
|
| .ldecl _ _ varName type val _ _ => do
|
||||||
|
let varName := varName.simpMacroScopes
|
||||||
|
let type ← instantiateMVars type
|
||||||
|
let value? ← if showLetValues then
|
||||||
|
let val ← instantiateMVars val
|
||||||
|
pure $ .some (← serialize_expression options val)
|
||||||
|
else
|
||||||
|
pure $ .none
|
||||||
|
return {
|
||||||
|
name := toString varName,
|
||||||
|
isInaccessible := varName.isInaccessibleUserName,
|
||||||
|
type := (← serialize_expression options type)
|
||||||
|
value? := value?
|
||||||
|
}
|
||||||
|
let vars ← lctx.foldlM (init := []) fun acc (localDecl : LocalDecl) => do
|
||||||
|
let skip := !ppAuxDecls && localDecl.isAuxDecl || !ppImplDetailHyps && localDecl.isImplementationDetail
|
||||||
|
if skip then
|
||||||
|
return acc
|
||||||
|
else
|
||||||
|
let var ← ppVars localDecl
|
||||||
|
return var::acc
|
||||||
|
return {
|
||||||
|
caseName? := match mvarDecl.userName with
|
||||||
|
| Name.anonymous => .none
|
||||||
|
| name => .some <| toString name,
|
||||||
|
isConversion := "| " == (Meta.getGoalPrefix mvarDecl)
|
||||||
|
target := (← serialize_expression options (← instantiateMVars mvarDecl.type)),
|
||||||
|
vars := vars.reverse.toArray
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
end Pantograph
|
end Pantograph
|
||||||
|
|
10
README.md
10
README.md
|
@ -33,7 +33,7 @@ result of a command execution. The command can be passed in one of two formats
|
||||||
command { ... }
|
command { ... }
|
||||||
{ "cmd": command, "payload": ... }
|
{ "cmd": command, "payload": ... }
|
||||||
```
|
```
|
||||||
The list of available commands can be found in `Pantograph/Commands.lean`. An
|
The list of available commands can be found in `Pantograph/Commands.lean` and below. An
|
||||||
empty command aborts the REPL.
|
empty command aborts the REPL.
|
||||||
|
|
||||||
The `Pantograph` executable must be run with a list of modules to import. It can
|
The `Pantograph` executable must be run with a list of modules to import. It can
|
||||||
|
@ -65,8 +65,13 @@ where the application of `assumption` should lead to a failure.
|
||||||
## Commands
|
## Commands
|
||||||
|
|
||||||
See `Pantograph/Commands.lean` for a description of the parameters and return values in Json.
|
See `Pantograph/Commands.lean` for a description of the parameters and return values in Json.
|
||||||
|
- `options.set { key: value, ... }`: Set one or more options (not Lean options; those
|
||||||
|
have to be set via command line arguments.)
|
||||||
|
- `options.print`: Display the current set of options
|
||||||
- `catalog`: Display a list of all safe Lean symbols in the current context
|
- `catalog`: Display a list of all safe Lean symbols in the current context
|
||||||
- `inspect {"name": <name>}`: Show the type and package of a given symbol
|
- `inspect {"name": <name>, "value": <bool>}`: Show the type and package of a
|
||||||
|
given symbol; If value flag is set, the value is printed or hidden. By default
|
||||||
|
only the values of definitions are printed.
|
||||||
- `clear`: Delete all cached expressions and proof trees
|
- `clear`: Delete all cached expressions and proof trees
|
||||||
- `expr.type {"expr": <expr>}`: Determine the type of an expression and round-trip it
|
- `expr.type {"expr": <expr>}`: Determine the type of an expression and round-trip it
|
||||||
- `proof.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`: Start a new proof state from a given expression or symbol
|
- `proof.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`: Start a new proof state from a given expression or symbol
|
||||||
|
@ -86,4 +91,3 @@ The tests are based on `LSpec`. To run tests,
|
||||||
``` sh
|
``` sh
|
||||||
test/all.sh
|
test/all.sh
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|
|
@ -9,6 +9,7 @@ unsafe def main := do
|
||||||
Lean.enableInitializersExecution
|
Lean.enableInitializersExecution
|
||||||
Lean.initSearchPath (← Lean.findSysroot)
|
Lean.initSearchPath (← Lean.findSysroot)
|
||||||
|
|
||||||
|
-- TODO: Add proper testing
|
||||||
let suites := [
|
let suites := [
|
||||||
test_serial,
|
test_serial,
|
||||||
test_proofs
|
test_proofs
|
||||||
|
|
Loading…
Reference in New Issue