1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
(***********************************************************************)
(* *)
(* GALAX *)
(* XQuery Engine *)
(* *)
(* Copyright 2001-2007. *)
(* Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $Id: variable_context_manager.ml,v 1.13 2007/02/01 22:08:45 simeon Exp $ *)
(* Module: Update_ordering
This module deals with variable context during runtime. It also
holds the build functions to access and store variables
*)
open Error
open Xquery_common_ast
open Namespace_names
open Physical_xml_value
open Physical_value
open Physical_value_util
open Array
(********************************)
(*** Variable Context Manager ***)
(********************************)
let empty_xml_value () = xml_value_of_item_list []
(* Consider using polymorphic types to close off after instantiated objects *)
type variable_context_manager = {
variable_stack : xml_value array Stack.t;
mutable current_variables : xml_value array ;
(* If we want to evaluate global variables lazily, we need
to cache the plan associated with the global variable
(algop) so that it can be executed on demand. Most
likely, that plan should go here. -Mary & Kristi
*)
last_slot : int ref;
(* Debugging parameters *)
id : int;
}
type variable_ref = variable_context_manager * int
let string_of_variable_ref v =
let cm, vr = v in
(string_of_int cm.id) ^ ":" ^ (string_of_int vr)
let get_new_variable_slot cm =
let ls = !(cm.last_slot) in
incr (cm.last_slot);
cm,ls
let debug_id = ref 0;;
(* We don't know the size at the outset *)
let build_context_manager () =
incr debug_id;
{ variable_stack = Stack.create ();
current_variables = Array.create 1 (empty_xml_value());
last_slot = ref 0;
id = !debug_id }
let instantiate_variable_context_manager cm =
Debug.print_dxq_debug ("Instantiating context " ^ (string_of_int cm.id) ^ " with " ^ (string_of_int !(cm.last_slot)));
cm.current_variables <- Array.create !(cm.last_slot) (empty_xml_value())
let build_variable_enter_context cm =
(fun () ->
Stack.push (Array.copy cm.current_variables) cm.variable_stack;
)
let build_variable_exit_context cm =
(fun () ->
try
let old_context = Stack.pop cm.variable_stack in
Array.blit old_context 0 cm.current_variables 0 !(cm.last_slot)
with Stack.Empty ->
raise (Query (Code_Selection ("Tried to exit an empty context")))
| Invalid_argument msg ->
raise (Query (Code_Selection ("Array.blit fails in build_variable_exit_context")))
)
(* Insert and retrieve and code *)
let build_parameter_insert_code cm vr =
(fun pv ->
try
cm.current_variables.(vr) <- pv
with _ ->
raise (Query(Code_Selection("Invalid variable offset "^(string_of_int vr)^" in build_parameter_list"))))
let build_variable_store_code (var_ref:variable_ref) =
let cm, vr = var_ref in
(fun pv ->
try
cm.current_variables.(vr) <- pv
with _ ->
raise (Query(Code_Selection("Invalid variable offset "^(string_of_int vr)^" in build_variable_store_code"))))
let build_variable_retrieve_code (var_ref:variable_ref) =
let cm, vr = var_ref in
(fun () ->
try
cm.current_variables.(vr)
with _ ->
raise (Query(Code_Selection("Invalid variable offset "^(string_of_int vr)^" in build_variable_retrieve_code"))))
let build_variable_assign_code (var_ref:variable_ref) rhs =
let cm, vr = var_ref in
(fun () ->
let pval = rhs() in
try
cm.current_variables.(vr) <- pval;
empty_xml_value ()
with _ ->
raise (Query(Code_Selection("Invalid variable offset "^(string_of_int vr)^" in build_variable_retrieve_code"))) )
|
