aboutsummaryrefslogtreecommitdiffhomepage
path: root/kernel
diff options
context:
space:
mode:
authorGravatar Matthieu Sozeau <matthieu.sozeau@inria.fr>2015-01-17 14:11:13 +0530
committerGravatar Matthieu Sozeau <matthieu.sozeau@inria.fr>2015-01-17 14:47:20 +0530
commit9d60a8655f37ee922c662d15b3df0d94a8fd32aa (patch)
treecae315894c17232930cbd0894bfb670a0c4fd6cb /kernel
parent9f5586d88880cbb98c92edfe9c33c76564f1a19c (diff)
Univs: Fix alias computation for VMs, computation of normal form of
match predicates for vm_compute and compile polymorphic definitions to constant code. Add univscompute test-suite file testing VM computations in presence of polymorphic universes.
Diffstat (limited to 'kernel')
-rw-r--r--kernel/cbytegen.ml2
-rw-r--r--kernel/term_typing.ml12
2 files changed, 9 insertions, 5 deletions
diff --git a/kernel/cbytegen.ml b/kernel/cbytegen.ml
index 65ee655da..d6c160c3d 100644
--- a/kernel/cbytegen.ml
+++ b/kernel/cbytegen.ml
@@ -490,7 +490,7 @@ let rec get_allias env (kn,u as p) =
let cb = lookup_constant kn env in
let tps = cb.const_body_code in
(match Cemitcodes.force tps with
- | BCallias kn' -> get_allias env kn'
+ | BCallias (kn',u') -> get_allias env (kn', Univ.subst_instance_instance u u')
| _ -> p)
(* Compiling expressions *)
diff --git a/kernel/term_typing.ml b/kernel/term_typing.ml
index 2e71b9806..a3441aa3e 100644
--- a/kernel/term_typing.ml
+++ b/kernel/term_typing.ml
@@ -248,10 +248,14 @@ let build_constant_declaration kn env (def,typ,proj,poly,univs,inline_code,ctx)
let inferred = keep_hyps env (Idset.union ids_typ ids_def) in
check declared inferred) lc) in
let tps =
- match proj with
- | None -> Cemitcodes.from_val (compile_constant_body env def)
- | Some pb ->
- Cemitcodes.from_val (compile_constant_body env (Def (Mod_subst.from_val pb.proj_body)))
+ (* FIXME: incompleteness of the bytecode vm: we compile polymorphic
+ constants like opaque definitions. *)
+ if poly then Cemitcodes.from_val Cemitcodes.BCconstant
+ else
+ match proj with
+ | None -> Cemitcodes.from_val (compile_constant_body env def)
+ | Some pb ->
+ Cemitcodes.from_val (compile_constant_body env (Def (Mod_subst.from_val pb.proj_body)))
in
{ const_hyps = hyps;
const_body = def;