From db06a1ddee4c79ea8f6903596284df2f2700ddac Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Fri, 9 Oct 2015 13:20:45 +0200 Subject: Complete handling of primitive projections in VM. This commit is a follow-up to a51cce369b9c634a93120092d4c7685a242d55b1 --- kernel/vm.ml | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'kernel/vm.ml') diff --git a/kernel/vm.ml b/kernel/vm.ml index 4607ad716..29e2ee601 100644 --- a/kernel/vm.ml +++ b/kernel/vm.ml @@ -314,6 +314,15 @@ let val_of_str_const str = val_of_obj (obj_of_str_const str) let val_of_atom a = val_of_obj (obj_of_atom a) +let atom_of_proj kn v = + let r = Obj.new_block proj_tag 2 in + Obj.set_field r 0 (Obj.repr kn); + Obj.set_field r 1 (Obj.repr v); + ((Obj.obj r) : atom) + +let val_of_proj kn v = + val_of_atom (atom_of_proj kn v) + module IdKeyHash = struct type t = pconstant tableKey @@ -560,6 +569,7 @@ let rec apply_stack a stk v = match stk with | [] -> apply_varray a [|v|] | Zapp args :: stk -> apply_stack (apply_arguments a args) stk v + | Zproj kn :: stk -> apply_stack (val_of_proj kn a) stk v | Zfix(f,args) :: stk -> let a,stk = match stk with -- cgit v1.2.3