aboutsummaryrefslogtreecommitdiff
path: root/spartan/core/implicits.ML
diff options
context:
space:
mode:
authorJosh Chen2021-01-31 02:54:51 +0000
committerJosh Chen2021-01-31 02:54:51 +0000
commit2feb56660700af107abb5a28a7120052ac405518 (patch)
treea18015cfa47928fb288037a78fe5b1d3bed87a92 /spartan/core/implicits.ML
parentaff3d43d9865e7b8d082f0c239d2c73eee1fb291 (diff)
rename things + some small changes
Diffstat (limited to 'spartan/core/implicits.ML')
-rw-r--r--spartan/core/implicits.ML87
1 files changed, 0 insertions, 87 deletions
diff --git a/spartan/core/implicits.ML b/spartan/core/implicits.ML
deleted file mode 100644
index 2b63f49..0000000
--- a/spartan/core/implicits.ML
+++ /dev/null
@@ -1,87 +0,0 @@
-(* Title: implicits.ML
- Author: Joshua Chen
-
-Implicit arguments.
-*)
-
-structure Implicits :
-sig
-
-val implicit_defs: Proof.context -> (term * term) Symtab.table
-val implicit_defs_attr: attribute
-val make_holes: Proof.context -> term list -> term list
-
-end = struct
-
-structure Defs = Generic_Data (
- type T = (term * term) Symtab.table
- val empty = Symtab.empty
- val extend = I
- val merge = Symtab.merge (Term.aconv o apply2 #1)
-)
-
-val implicit_defs = Defs.get o Context.Proof
-
-val implicit_defs_attr = Thm.declaration_attribute (fn th =>
- let
- val (t, def) = Lib.dest_eq (Thm.prop_of th)
- val (head, args) = Term.strip_comb t
- val def' = fold_rev lambda args def
- in
- Defs.map (Symtab.update (Term.term_name head, (head, def')))
- end)
-
-fun make_holes_single ctxt tm name_ctxt =
- let
- fun iarg_to_hole (Const (\<^const_name>\<open>iarg\<close>, T)) =
- Const (\<^const_name>\<open>hole\<close>, T)
- | iarg_to_hole t = t
-
- fun expand head args =
- let fun betapplys (head', args') =
- Term.betapplys (map_aterms iarg_to_hole head', args')
- in
- case head of
- Abs (x, T, t) =>
- list_comb (Abs (x, T, Lib.traverse_term expand t), args)
- | _ =>
- case Symtab.lookup (implicit_defs ctxt) (Term.term_name head) of
- SOME (t, def) => betapplys
- (Envir.expand_atom
- (Term.fastype_of head)
- (Term.fastype_of t, def),
- args)
- | NONE => list_comb (head, args)
- end
-
- fun holes_to_vars t =
- let
- val count = Lib.subterm_count (Const (\<^const_name>\<open>hole\<close>, dummyT))
-
- fun subst (Const (\<^const_name>\<open>hole\<close>, T)) (Var (idx, _)::_) Ts =
- let
- val bounds = map Bound (0 upto (length Ts - 1))
- val T' = foldr1 (op -->) (Ts @ [T])
- in
- foldl1 (op $) (Var (idx, T')::bounds)
- end
- | subst (Abs (x, T, t)) vs Ts = Abs (x, T, subst t vs (T::Ts))
- | subst (t $ u) vs Ts =
- let val n = count t
- in subst t (take n vs) Ts $ subst u (drop n vs) Ts end
- | subst t _ _ = t
-
- val names = Name.invent name_ctxt "*" (count t)
- val vars = map (fn n => Var ((n, 0), dummyT)) names
- in
- (subst t vars [], fold Name.declare names name_ctxt)
- end
- in
- holes_to_vars (Lib.traverse_term expand tm)
- end
-
-fun make_holes ctxt tms = #1
- (fold_map (make_holes_single ctxt) tms (Variable.names_of ctxt))
-
-
-end