diff options
| author | Josh Chen | 2020-07-31 14:56:24 +0200 |
|---|---|---|
| committer | Josh Chen | 2020-07-31 14:56:24 +0200 |
| commit | ff5454812f9e2720bd90c3a5437505644f63b487 (patch) | |
| tree | 2df5f45de006c56391118db75e2f185036b02cd7 /spartan/core/elaboration.ML | |
| parent | 2b0e14b16dcef0e829da95800b3c0af1975bb1ce (diff) | |
(FEAT) Term elaboration of assumption and goal statements.
. spartan/core/goals.ML
. spartan/core/elaboration.ML
. spartan/core/elaborated_statement.ML
(FEAT) More context tacticals and search tacticals.
. spartan/core/context_tactical.ML
(FEAT) Improved subgoal focus.
Moves fully elaborated assumptions into the context (MINOR INCOMPATIBILITY).
. spartan/core/focus.ML
(FIX) Normalize facts in order to be able to resolve properly.
. spartan/core/typechecking.ML
(MAIN) New definitions.
(MAIN) Renamed theories and theorems.
(MAIN) Refactor theories to fit new features.
Diffstat (limited to '')
| -rw-r--r-- | spartan/core/elaboration.ML | 17 |
1 files changed, 16 insertions, 1 deletions
diff --git a/spartan/core/elaboration.ML b/spartan/core/elaboration.ML index 27b6bb0..9e5e0bd 100644 --- a/spartan/core/elaboration.ML +++ b/spartan/core/elaboration.ML @@ -1,13 +1,14 @@ (* Title: elaboration.ML Author: Joshua Chen -Basic elaboration. +Basic term elaboration. *) structure Elab: sig val elab: Proof.context -> cterm list -> term -> Envir.env val elab_stmt: Proof.context -> cterm list -> term -> Envir.env * term +val elaborate: Proof.context -> cterm list -> ('a * (term * term list) list) list -> ('a * (term * term list) list) list end = struct @@ -72,5 +73,19 @@ fun elab_stmt ctxt assums stmt = in (subst', subst_term subst' stmt) end end +(*Apply elaboration to the list format that assumptions and goal statements are + given in*) +fun elaborate ctxt known assms = + let + fun subst_term env = Envir.subst_term (Envir.type_env env, Envir.term_env env) + fun elab_fact (fact, xs) assums = + let val (subst, fact') = elab_stmt ctxt assums fact in + ((fact', map (subst_term subst) xs), Thm.cterm_of ctxt fact' :: assums) + end + fun elab (b, facts) assums = + let val (facts', assums') = fold_map elab_fact facts assums + in ((b, facts'), assums') end + in #1 (fold_map elab assms known) end + end |