version bump, restructure
This commit is contained in:
parent
a00a2b4a42
commit
d705cdf0e5
213
Main.lean
213
Main.lean
|
|
@ -1,173 +1,8 @@
|
|||
import Lean.Data.Json
|
||||
import Lean.Environment
|
||||
|
||||
import Pantograph.Commands
|
||||
import Pantograph.Serial
|
||||
import Pantograph.Meta
|
||||
import Pantograph.Symbols
|
||||
|
||||
namespace Pantograph
|
||||
|
||||
|
||||
structure Context where
|
||||
|
||||
/-- Stores state of the REPL -/
|
||||
structure State where
|
||||
--environments: Array Lean.Environment := #[]
|
||||
proofTrees: Array ProofTree := #[]
|
||||
|
||||
-- State monad
|
||||
abbrev Subroutine := ReaderT Context (StateT State Lean.Elab.TermElabM)
|
||||
|
||||
open Commands
|
||||
|
||||
/-- Parse a command either in `{ "cmd": ..., "payload": ... }` form or `cmd { ... }` form. -/
|
||||
def parse_command (s: String): Except String Command := do
|
||||
let s := s.trim
|
||||
match s.get? 0 with
|
||||
| .some '{' => -- Parse in Json mode
|
||||
Lean.fromJson? (← Lean.Json.parse s)
|
||||
| .some _ => -- Parse in line mode
|
||||
let offset := s.posOf ' ' |> s.offsetOfPos
|
||||
if offset = s.length then
|
||||
return { cmd := s.take offset, payload := Lean.Json.null }
|
||||
else
|
||||
let payload ← s.drop offset |> Lean.Json.parse
|
||||
return { cmd := s.take offset, payload := payload }
|
||||
| .none => throw "Command is empty"
|
||||
|
||||
def execute (command: Command): Subroutine Lean.Json := do
|
||||
match command.cmd with
|
||||
| "catalog" =>
|
||||
match Lean.fromJson? command.payload with
|
||||
| .ok args => catalog args
|
||||
| .error x => return errorJson x
|
||||
| "inspect" =>
|
||||
match Lean.fromJson? command.payload with
|
||||
| .ok args => inspect args
|
||||
| .error x => return errorJson x
|
||||
| "clear" => clear
|
||||
| "expr.type" =>
|
||||
match Lean.fromJson? command.payload with
|
||||
| .ok args => expr_type args
|
||||
| .error x => return errorJson x
|
||||
| "proof.start" =>
|
||||
match Lean.fromJson? command.payload with
|
||||
| .ok args => proof_start args
|
||||
| .error x => return errorJson x
|
||||
| "proof.tactic" =>
|
||||
match Lean.fromJson? command.payload with
|
||||
| .ok args => proof_tactic args
|
||||
| .error x => return errorJson x
|
||||
| "proof.printTree" =>
|
||||
match Lean.fromJson? command.payload with
|
||||
| .ok args => proof_print_tree args
|
||||
| .error x => return errorJson x
|
||||
| cmd =>
|
||||
let error: InteractionError := { error := "unknown", desc := s!"Unknown command {cmd}" }
|
||||
return Lean.toJson error
|
||||
where
|
||||
errorI (type desc: String) := Lean.toJson ({ error := type, desc := desc }: InteractionError)
|
||||
errorJson := errorI "json"
|
||||
errorIndex := errorI "index"
|
||||
catalog (_: Catalog): Subroutine Lean.Json := do
|
||||
let env ← Lean.MonadEnv.getEnv
|
||||
let names := env.constants.fold (init := #[]) (λ acc name info =>
|
||||
match to_filtered_symbol name info with
|
||||
| .some x => acc.push x
|
||||
| .none => acc)
|
||||
return Lean.toJson <| ({ symbols := names }: CatalogResult)
|
||||
inspect (args: Inspect): Subroutine Lean.Json := do
|
||||
let env ← Lean.MonadEnv.getEnv
|
||||
let name := str_to_name args.name
|
||||
let info? := env.find? name
|
||||
match info? with
|
||||
| none => return errorIndex s!"Symbol not found {args.name}"
|
||||
| some info =>
|
||||
let format ← Lean.Meta.ppExpr info.toConstantVal.type
|
||||
let module? := env.getModuleIdxFor? name >>=
|
||||
(λ idx => env.allImportedModuleNames.get? idx.toNat) |>.map toString
|
||||
let boundExpr? ← (match info.toConstantVal.type with
|
||||
| .forallE _ _ _ _ => return .some (← type_expr_to_bound info.toConstantVal.type)
|
||||
| _ => return Option.none)
|
||||
return Lean.toJson ({
|
||||
type := toString format,
|
||||
boundExpr? := boundExpr?,
|
||||
module? := module?
|
||||
}: InspectResult)
|
||||
clear : Subroutine Lean.Json := do
|
||||
let state ← get
|
||||
let nTrees := state.proofTrees.size
|
||||
set { state with proofTrees := #[] }
|
||||
return Lean.toJson ({ nTrees := nTrees }: ClearResult)
|
||||
expr_type (args: ExprType): Subroutine Lean.Json := do
|
||||
let env ← Lean.MonadEnv.getEnv
|
||||
match syntax_from_str env args.expr with
|
||||
| .error str => return errorI "parsing" str
|
||||
| .ok syn => do
|
||||
match (← syntax_to_expr syn) with
|
||||
| .error str => return errorI "elab" str
|
||||
| .ok expr => do
|
||||
try
|
||||
let format ← Lean.Meta.ppExpr (← Lean.Meta.inferType expr)
|
||||
return Lean.toJson <| ({
|
||||
type := toString format,
|
||||
roundTrip := toString <| (← Lean.Meta.ppExpr expr)
|
||||
}: ExprTypeResult)
|
||||
catch exception =>
|
||||
return errorI "typing" (← exception.toMessageData.toString)
|
||||
proof_start (args: ProofStart): Subroutine Lean.Json := do
|
||||
let state ← get
|
||||
let env ← Lean.MonadEnv.getEnv
|
||||
let expr?: Except Lean.Json Lean.Expr ← (match args.expr, args.copyFrom with
|
||||
| .some expr, .none =>
|
||||
(match syntax_from_str env expr with
|
||||
| .error str => return .error <| errorI "parsing" str
|
||||
| .ok syn => do
|
||||
(match (← syntax_to_expr syn) with
|
||||
| .error str => return .error <| errorI "elab" str
|
||||
| .ok expr => return .ok expr))
|
||||
| .none, .some copyFrom =>
|
||||
(match env.find? <| str_to_name copyFrom with
|
||||
| .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
|
||||
| .some cInfo => return .ok cInfo.type)
|
||||
| .none, .none =>
|
||||
return .error <| errorI "arguments" "At least one of {expr, copyFrom} must be supplied"
|
||||
| _, _ => return .error <| errorI "arguments" "Cannot populate both of {expr, copyFrom}")
|
||||
match expr? with
|
||||
| .error error => return error
|
||||
| .ok expr =>
|
||||
let tree ← ProofTree.create (str_to_name <| args.name.getD "Untitled") expr
|
||||
-- Put the new tree in the environment
|
||||
let nextTreeId := state.proofTrees.size
|
||||
set { state with proofTrees := state.proofTrees.push tree }
|
||||
return Lean.toJson ({ treeId := nextTreeId }: ProofStartResult)
|
||||
proof_tactic (args: ProofTactic): Subroutine Lean.Json := do
|
||||
let state ← get
|
||||
match state.proofTrees.get? args.treeId with
|
||||
| .none => return errorIndex "Invalid tree index {args.treeId}"
|
||||
| .some tree =>
|
||||
let (result, nextTree) ← ProofTree.execute
|
||||
(stateId := args.stateId)
|
||||
(goalId := args.goalId.getD 0)
|
||||
(tactic := args.tactic) |>.run tree
|
||||
match result with
|
||||
| .invalid message => return Lean.toJson <| errorIndex message
|
||||
| .success nextId? goals =>
|
||||
set { state with proofTrees := state.proofTrees.set! args.treeId nextTree }
|
||||
return Lean.toJson ({ nextId? := nextId?, goals := goals }: ProofTacticResultSuccess)
|
||||
| .failure messages =>
|
||||
return Lean.toJson ({ tacticErrors := messages }: ProofTacticResultFailure)
|
||||
proof_print_tree (args: ProofPrintTree): Subroutine Lean.Json := do
|
||||
let state ← get
|
||||
match state.proofTrees.get? args.treeId with
|
||||
| .none => return errorIndex "Invalid tree index {args.treeId}"
|
||||
| .some tree =>
|
||||
return Lean.toJson ({parents := tree.structure_array}: ProofPrintTreeResult)
|
||||
|
||||
|
||||
end Pantograph
|
||||
|
||||
import Pantograph.Version
|
||||
import Pantograph
|
||||
|
||||
-- Main IO functions
|
||||
open Pantograph
|
||||
|
|
@ -184,38 +19,22 @@ unsafe def loop : Subroutine Unit := do
|
|||
IO.println <| toString <| ret
|
||||
loop
|
||||
|
||||
namespace Lean
|
||||
-- This is better than the default version since it handles `.`
|
||||
def setOptionFromString' (opts : Options) (entry : String) : IO Options := do
|
||||
let ps := (entry.splitOn "=").map String.trim
|
||||
let [key, val] ← pure ps | throw $ IO.userError "invalid configuration option entry, it must be of the form '<key> = <value>'"
|
||||
let key := 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 $ IO.userError s!"invalid Bool option value '{val}'"
|
||||
| DataValue.ofName _ => pure $ opts.setName key val.toName
|
||||
| DataValue.ofNat _ =>
|
||||
match val.toNat? with
|
||||
| none => throw (IO.userError s!"invalid Nat option value '{val}'")
|
||||
| some v => pure $ opts.setNat key v
|
||||
| DataValue.ofInt _ =>
|
||||
match val.toInt? with
|
||||
| none => throw (IO.userError s!"invalid Int option value '{val}'")
|
||||
| some v => pure $ opts.setInt key v
|
||||
| DataValue.ofSyntax _ => throw (IO.userError s!"invalid Syntax option value")
|
||||
end Lean
|
||||
|
||||
unsafe def main (args: List String): IO Unit := do
|
||||
-- NOTE: A more sophisticated scheme of command line argument handling is needed.
|
||||
-- Separate imports and options
|
||||
if args == ["--version"] then do
|
||||
println! s!"{version}"
|
||||
return
|
||||
|
||||
Lean.enableInitializersExecution
|
||||
Lean.initSearchPath (← Lean.findSysroot)
|
||||
|
||||
-- Separate imports and options
|
||||
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
|
||||
|>.run
|
||||
let options ← match options? with
|
||||
| .ok options => pure options
|
||||
| .error e => throw $ IO.userError s!"Options cannot be parsed: {e}"
|
||||
let imports:= args.filter (λ s => ¬ (s.startsWith "--"))
|
||||
|
||||
let env ← Lean.importModules
|
||||
|
|
@ -225,11 +44,11 @@ unsafe def main (args: List String): IO Unit := do
|
|||
let context: Context := {
|
||||
}
|
||||
let coreContext: Lean.Core.Context := {
|
||||
currNamespace := str_to_name "Aniva",
|
||||
currNamespace := Lean.Name.str .anonymous "Aniva"
|
||||
openDecls := [], -- No 'open' directives needed
|
||||
fileName := "<Pantograph>",
|
||||
fileMap := { source := "", positions := #[0], lines := #[1] },
|
||||
options := ← options.foldlM Lean.setOptionFromString' Lean.Options.empty
|
||||
options := options
|
||||
}
|
||||
try
|
||||
let termElabM := loop.run context |>.run' {}
|
||||
|
|
|
|||
207
Pantograph.lean
207
Pantograph.lean
|
|
@ -1,2 +1,209 @@
|
|||
import Pantograph.Commands
|
||||
import Pantograph.Serial
|
||||
import Pantograph.Meta
|
||||
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
|
||||
|
||||
structure Context where
|
||||
|
||||
/-- Stores state of the REPL -/
|
||||
structure State where
|
||||
--environments: Array Lean.Environment := #[]
|
||||
proofTrees: Array ProofTree := #[]
|
||||
|
||||
-- State monad
|
||||
abbrev Subroutine := ReaderT Context (StateT State Lean.Elab.TermElabM)
|
||||
|
||||
/-- Parse a command either in `{ "cmd": ..., "payload": ... }` form or `cmd { ... }` form. -/
|
||||
def parse_command (s: String): Except String Commands.Command := do
|
||||
let s := s.trim
|
||||
match s.get? 0 with
|
||||
| .some '{' => -- Parse in Json mode
|
||||
Lean.fromJson? (← Lean.Json.parse s)
|
||||
| .some _ => -- Parse in line mode
|
||||
let offset := s.posOf ' ' |> s.offsetOfPos
|
||||
if offset = s.length then
|
||||
return { cmd := s.take offset, payload := Lean.Json.null }
|
||||
else
|
||||
let payload ← s.drop offset |> Lean.Json.parse
|
||||
return { cmd := s.take offset, payload := payload }
|
||||
| .none => throw "Command is empty"
|
||||
|
||||
def execute (command: Commands.Command): Subroutine Lean.Json := do
|
||||
match command.cmd with
|
||||
| "option.set" =>
|
||||
match Lean.fromJson? command.payload with
|
||||
| .ok args => option_set args
|
||||
| .error x => return errorJson x
|
||||
| "catalog" =>
|
||||
match Lean.fromJson? command.payload with
|
||||
| .ok args => catalog args
|
||||
| .error x => return errorJson x
|
||||
| "inspect" =>
|
||||
match Lean.fromJson? command.payload with
|
||||
| .ok args => inspect args
|
||||
| .error x => return errorJson x
|
||||
| "clear" => clear
|
||||
| "expr.type" =>
|
||||
match Lean.fromJson? command.payload with
|
||||
| .ok args => expr_type args
|
||||
| .error x => return errorJson x
|
||||
| "proof.start" =>
|
||||
match Lean.fromJson? command.payload with
|
||||
| .ok args => proof_start args
|
||||
| .error x => return errorJson x
|
||||
| "proof.tactic" =>
|
||||
match Lean.fromJson? command.payload with
|
||||
| .ok args => proof_tactic args
|
||||
| .error x => return errorJson x
|
||||
| "proof.printTree" =>
|
||||
match Lean.fromJson? command.payload with
|
||||
| .ok args => proof_print_tree args
|
||||
| .error x => return errorJson x
|
||||
| cmd =>
|
||||
let error: Commands.InteractionError :=
|
||||
{ error := "unknown", desc := s!"Unknown command {cmd}" }
|
||||
return Lean.toJson error
|
||||
where
|
||||
errorI (type desc: String) := Lean.toJson (
|
||||
{ error := type, desc := desc }: Commands.InteractionError)
|
||||
errorJson := errorI "json"
|
||||
errorIndex := errorI "index"
|
||||
option_set (args: Commands.OptionSet): Subroutine Lean.Json := do
|
||||
let options? ← args.options.foldlM Lean.setOptionFromString'' Lean.Options.empty
|
||||
|>.run
|
||||
match options? with
|
||||
| .ok options =>
|
||||
withTheReader Lean.Core.Context
|
||||
(λ coreContext => { coreContext with options })
|
||||
(pure $ Lean.toJson <| ({ }: Commands.OptionSetResult))
|
||||
| .error e =>
|
||||
return errorI "parsing" e
|
||||
catalog (_: Commands.Catalog): Subroutine Lean.Json := do
|
||||
let env ← Lean.MonadEnv.getEnv
|
||||
let names := env.constants.fold (init := #[]) (λ acc name info =>
|
||||
match to_filtered_symbol name info with
|
||||
| .some x => acc.push x
|
||||
| .none => acc)
|
||||
return Lean.toJson <| ({ symbols := names }: Commands.CatalogResult)
|
||||
inspect (args: Commands.Inspect): Subroutine Lean.Json := do
|
||||
let env ← Lean.MonadEnv.getEnv
|
||||
let name := str_to_name args.name
|
||||
let info? := env.find? name
|
||||
match info? with
|
||||
| none => return errorIndex s!"Symbol not found {args.name}"
|
||||
| some info =>
|
||||
let format ← Lean.Meta.ppExpr info.toConstantVal.type
|
||||
let module? := env.getModuleIdxFor? name >>=
|
||||
(λ idx => env.allImportedModuleNames.get? idx.toNat) |>.map toString
|
||||
let boundExpr? ← (match info.toConstantVal.type with
|
||||
| .forallE _ _ _ _ => return Option.none -- TODO: Temporary override, enable expression dissection in options.
|
||||
-- return .some (← type_expr_to_bound info.toConstantVal.type)
|
||||
| _ => return Option.none)
|
||||
return Lean.toJson ({
|
||||
type := toString format,
|
||||
boundExpr? := boundExpr?,
|
||||
module? := module?
|
||||
}: Commands.InspectResult)
|
||||
clear : Subroutine Lean.Json := do
|
||||
let state ← get
|
||||
let nTrees := state.proofTrees.size
|
||||
set { state with proofTrees := #[] }
|
||||
return Lean.toJson ({ nTrees := nTrees }: Commands.ClearResult)
|
||||
expr_type (args: Commands.ExprType): Subroutine Lean.Json := do
|
||||
let env ← Lean.MonadEnv.getEnv
|
||||
match syntax_from_str env args.expr with
|
||||
| .error str => return errorI "parsing" str
|
||||
| .ok syn => do
|
||||
match (← syntax_to_expr syn) with
|
||||
| .error str => return errorI "elab" str
|
||||
| .ok expr => do
|
||||
try
|
||||
let format ← Lean.Meta.ppExpr (← Lean.Meta.inferType expr)
|
||||
return Lean.toJson <| ({
|
||||
type := toString format,
|
||||
roundTrip := toString <| (← Lean.Meta.ppExpr expr)
|
||||
}: Commands.ExprTypeResult)
|
||||
catch exception =>
|
||||
return errorI "typing" (← exception.toMessageData.toString)
|
||||
proof_start (args: Commands.ProofStart): Subroutine Lean.Json := do
|
||||
let state ← get
|
||||
let env ← Lean.MonadEnv.getEnv
|
||||
let expr?: Except Lean.Json Lean.Expr ← (match args.expr, args.copyFrom with
|
||||
| .some expr, .none =>
|
||||
(match syntax_from_str env expr with
|
||||
| .error str => return .error <| errorI "parsing" str
|
||||
| .ok syn => do
|
||||
(match (← syntax_to_expr syn) with
|
||||
| .error str => return .error <| errorI "elab" str
|
||||
| .ok expr => return .ok expr))
|
||||
| .none, .some copyFrom =>
|
||||
(match env.find? <| str_to_name copyFrom with
|
||||
| .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
|
||||
| .some cInfo => return .ok cInfo.type)
|
||||
| .none, .none =>
|
||||
return .error <| errorI "arguments" "At least one of {expr, copyFrom} must be supplied"
|
||||
| _, _ => return .error <| errorI "arguments" "Cannot populate both of {expr, copyFrom}")
|
||||
match expr? with
|
||||
| .error error => return error
|
||||
| .ok expr =>
|
||||
let tree ← ProofTree.create (str_to_name <| args.name.getD "Untitled") expr
|
||||
-- Put the new tree in the environment
|
||||
let nextTreeId := state.proofTrees.size
|
||||
set { state with proofTrees := state.proofTrees.push tree }
|
||||
return Lean.toJson ({ treeId := nextTreeId }: Commands.ProofStartResult)
|
||||
proof_tactic (args: Commands.ProofTactic): Subroutine Lean.Json := do
|
||||
let state ← get
|
||||
match state.proofTrees.get? args.treeId with
|
||||
| .none => return errorIndex "Invalid tree index {args.treeId}"
|
||||
| .some tree =>
|
||||
let (result, nextTree) ← ProofTree.execute
|
||||
(stateId := args.stateId)
|
||||
(goalId := args.goalId.getD 0)
|
||||
(tactic := args.tactic) |>.run tree
|
||||
match result with
|
||||
| .invalid message => return Lean.toJson <| errorIndex message
|
||||
| .success nextId? goals =>
|
||||
set { state with proofTrees := state.proofTrees.set! args.treeId nextTree }
|
||||
return Lean.toJson (
|
||||
{ nextId? := nextId?, goals := goals }: Commands.ProofTacticResultSuccess)
|
||||
| .failure messages =>
|
||||
return Lean.toJson (
|
||||
{ tacticErrors := messages }: Commands.ProofTacticResultFailure)
|
||||
proof_print_tree (args: Commands.ProofPrintTree): Subroutine Lean.Json := do
|
||||
let state ← get
|
||||
match state.proofTrees.get? args.treeId with
|
||||
| .none => return errorIndex "Invalid tree index {args.treeId}"
|
||||
| .some tree =>
|
||||
return Lean.toJson ({parents := tree.structure_array}: Commands.ProofPrintTreeResult)
|
||||
|
||||
|
||||
end Pantograph
|
||||
|
|
|
|||
|
|
@ -21,7 +21,16 @@ structure InteractionError where
|
|||
deriving Lean.ToJson
|
||||
|
||||
|
||||
-- Individual command and return types
|
||||
--- Individual command and return types ---
|
||||
|
||||
-- Set Lean options supplied in the form of
|
||||
--
|
||||
-- option=value
|
||||
structure OptionSet where
|
||||
options: Array String
|
||||
deriving Lean.FromJson
|
||||
structure OptionSetResult where
|
||||
deriving Lean.ToJson
|
||||
|
||||
|
||||
-- Print all symbols in environment
|
||||
|
|
@ -38,7 +47,7 @@ structure Inspect where
|
|||
structure InspectResult where
|
||||
type: String
|
||||
-- Decompose the bound expression when the type is forall.
|
||||
boundExpr?: Option BoundExpression
|
||||
boundExpr?: Option BoundExpression := Option.none
|
||||
module?: Option String
|
||||
deriving Lean.ToJson
|
||||
|
||||
|
|
|
|||
|
|
@ -117,4 +117,64 @@ def serialize_goal (mvarDecl: MetavarDecl) : MetaM Goal := do
|
|||
vars := vars.reverse.toArray
|
||||
}
|
||||
|
||||
/-- Completely serialises an expression tree. Json not used due to compactness -/
|
||||
def serialize_expression_ast (expr: Expr): MetaM String := do
|
||||
match expr with
|
||||
| .bvar deBruijnIndex => return s!"(:bv {deBruijnIndex})"
|
||||
| .fvar fvarId =>
|
||||
let name := (← fvarId.getDecl).userName
|
||||
return s!"(:fv {name})"
|
||||
| .mvar _ =>
|
||||
-- mvarId is ignored.
|
||||
return s!":mv"
|
||||
| .sort u => return s!"(:sort {u.depth})"
|
||||
| .const declName _ =>
|
||||
-- The universe level of the const expression is elided since it should be
|
||||
-- inferrable from surrounding expression
|
||||
return s!"(:const {declName})"
|
||||
| .app fn arg =>
|
||||
let fn' ← serialize_expression_ast fn
|
||||
let arg' ← serialize_expression_ast arg
|
||||
return s!"(:app {fn'} {arg'})"
|
||||
| .lam binderName binderType body binderInfo =>
|
||||
let binderType' ← serialize_expression_ast binderType
|
||||
let body' ← serialize_expression_ast body
|
||||
let binderInfo' := binderInfoToAst binderInfo
|
||||
return s!"(:lam {binderName} {binderType'} {body'} :{binderInfo'})"
|
||||
| .forallE binderName binderType body binderInfo =>
|
||||
let binderType' ← serialize_expression_ast binderType
|
||||
let body' ← serialize_expression_ast body
|
||||
let binderInfo' := binderInfoToAst binderInfo
|
||||
return s!"(:forall {binderName} {binderType'} {body'} :{binderInfo'})"
|
||||
| .letE name type value body _ =>
|
||||
-- Dependent boolean flag diacarded
|
||||
let type' ← serialize_expression_ast type
|
||||
let value' ← serialize_expression_ast value
|
||||
let body' ← serialize_expression_ast body
|
||||
return s!"(:let {name} {type'} {value'} {body'})"
|
||||
| .lit v =>
|
||||
return (match v with
|
||||
| .natVal val => toString val
|
||||
| .strVal val => s!"\"{val}\"")
|
||||
| .mdata _ expr =>
|
||||
-- NOTE: Equivalent to expr itself, but mdata influences the prettyprinter
|
||||
return (← serialize_expression_ast expr)
|
||||
| .proj typeName idx struct =>
|
||||
let struct' ← serialize_expression_ast struct
|
||||
return s!"(:proj {typeName} {idx} {struct'})"
|
||||
|
||||
where
|
||||
binderInfoToAst : Lean.BinderInfo → String
|
||||
| .default => "default"
|
||||
| .implicit => "implicit"
|
||||
| .strictImplicit => "strictImplicit"
|
||||
| .instImplicit => "instImplicit"
|
||||
|
||||
/-- Serialised expression object --/
|
||||
structure Expression where
|
||||
prettyprinted?: Option String := .none
|
||||
bound?: Option BoundExpression := .none
|
||||
sexp?: Option String := .none
|
||||
deriving ToJson
|
||||
|
||||
end Pantograph
|
||||
|
|
|
|||
|
|
@ -0,0 +1,5 @@
|
|||
namespace Pantograph
|
||||
|
||||
def version := "0.2"
|
||||
|
||||
end Pantograph
|
||||
|
|
@ -23,7 +23,7 @@ Note that `lean-toolchain` must be present in the `$PWD` in order to run Pantogr
|
|||
## Usage
|
||||
|
||||
``` sh
|
||||
build/bin/pantograph OPTIONS|MODULES
|
||||
build/bin/pantograph MODULES|LEAN_OPTIONS
|
||||
```
|
||||
|
||||
The REPL loop accepts commands as single-line JSON inputs and outputs either an
|
||||
|
|
@ -37,7 +37,7 @@ The list of available commands can be found in `Pantograph/Commands.lean`. An
|
|||
empty command aborts the REPL.
|
||||
|
||||
The `Pantograph` executable must be run with a list of modules to import. It can
|
||||
also accept options of the form `--key=value` e.g. `--pp.raw=true`.
|
||||
also accept lean options of the form `--key=value` e.g. `--pp.raw=true`.
|
||||
|
||||
Example: (~5k symbols)
|
||||
```
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
import LSpec
|
||||
import Pantograph.Symbols
|
||||
import Test.Integration
|
||||
import Test.Proofs
|
||||
import Test.Serial
|
||||
|
||||
|
|
@ -12,6 +12,7 @@ unsafe def main := do
|
|||
let suites := [
|
||||
test_serial,
|
||||
test_proofs
|
||||
--test_integration
|
||||
]
|
||||
let all ← suites.foldlM (λ acc m => do pure $ acc ++ (← m)) LSpec.TestSeq.done
|
||||
LSpec.lspecIO $ all
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
leanprover/lean4:nightly-2023-05-06
|
||||
leanprover/lean4:nightly-2023-08-12
|
||||
|
|
|
|||
Loading…
Reference in New Issue