plugin for sql
[afterthought.git] / aft_il.ml
1 open Xpath_syntax
2 open Xpath_ext
3 open Aft_types
4 open Globals
5 open Array
6
7 type aft_symtab = (path_expr, int) Hashtbl.t
8 type aft_syms = path_expr array
9 type aft_minterm = (path_expr,int) Hashtbl.t * (int list) list
10
11 exception EvalAxisNotSupported
12
13 let aft_to_minterms aft_rep =
14   let minterm_hash:aft_symtab = Hashtbl.create 128 in
15   let syms:aft_syms = Array.create 128 (Expr(Number_literal(1.0))) in
16   let hash_index = ref 0 in
17   let rec aft_to_minterms_rec prefix cur_term (aft_rep: access_spec) = 
18     let rec pattern_match_to_minterms_rec prefix cur_term (pat_match: clause list) =
19         match pat_match with
20             Clause(m, aspec)::cdr -> 
21               let term = try Hashtbl.find minterm_hash m with
22                 | Not_found ->
23                     Hashtbl.add minterm_hash m !hash_index;
24                     Array.set syms !hash_index m;
25                   hash_index := !hash_index + 1;
26                   !hash_index-1
27               in
28               let right_function = pattern_match_to_minterms_rec ((term+255)::prefix) cur_term cdr in
29                 aft_to_minterms_rec (term::prefix) right_function aspec
30             | [] -> cur_term
31     in
32     match aft_rep with
33       | PatternMatch(cl_list) -> 
34           pattern_match_to_minterms_rec prefix cur_term cl_list
35       | Filter(Number_literal(x))->
36           if (x=0.0) then
37             cur_term
38           else
39           if (x=1.0) then (prefix::cur_term)
40           else begin
41             print "Reached leaf %f" x;raise Aft_error
42           end
43       | _ -> 
44             cur_term
45   in
46   let minterm_list = aft_to_minterms_rec [] [] aft_rep in
47     (minterm_list, syms, !hash_index)
48
49 let rec eval xpath_path =
50   match xpath_path with 
51     | Expr(expr) ->
52         0
53     | Pipe(e1,e2) ->  
54         let v = eval e1 in
55           if (-1=v) then eval e2 else v
56     | Slash(e1,e2) ->
57         let v = eval e1 in
58           if (-1=v) then eval e2 else v
59     | Condition(e,expr) ->
60         eval e
61     | Root ->
62         -1
63     | Axis(_,e)->
64         eval e
65     | Name(s)->
66         let c = String.get s 0 in
67         let ic = int_of_char c in
68           if (ic > 64 && ic < 91) then 1 else 0
69     | _ -> raise EvalAxisNotSupported
70
71 let optimize_minterms m_syms n =
72   let rec gen_lst n suffix = if (n==(-1)) then suffix else gen_lst (n-1) (n::suffix) in
73   let lst = gen_lst (n-1) [] in
74   let cmp_func a1 a2 = 
75     let term1 = Array.get m_syms a1 in
76     let term2 = Array.get m_syms a2 in
77       if ((eval term1) > (eval term2)) then 1 else 0
78   in
79   List.stable_sort cmp_func lst
80
81 let rec minterms_to_aft m_list m_syms order n_terms =
82   match order with
83     | [] ->
84         const_to_aft m_list
85     | car::cdr ->
86         let right = reduce_true m_syms car m_list in
87         let left = reduce_false m_syms car m_list in
88         let right_aft = minterms_to_aft right m_syms cdr (n_terms-1) in
89         let left_aft = minterms_to_aft left m_syms cdr (n_terms-1) in
90           PatternMatch ((var_to_aft car m_syms) (True(right_aft)) (False(left_aft))) 
91
92 let rec aft_to_il l_inp = 
93   let rec aft_to_il_rec prefix cur_term (aft_rep: access_spec) = 
94     let rec pattern_match_to_il  (pat_match: clause list) =
95         match pat_match with
96             Clause(m, aspec)::cdr -> 
97               let right_function = pattern_match_to_il cdr in
98                 aft_to_minterms_rec (term::prefix) right_function aspec
99             | [] -> cur_term
100     in
101     match aft_rep with
102       | PatternMatch(cl_list) -> 
103           pattern_match_to_minterms_rec prefix cur_term cl_list
104       | Filter(Number_literal(x))->
105           if (x=0.0) then
106             cur_term
107           else
108           if (x=1.0) then (prefix::cur_term)
109           else begin
110             print "Reached leaf %f" x;raise Aft_error
111           end
112       | _ -> 
113             cur_term
114   in
115   let minterm_list = aft_to_minterms_rec [] [] aft_rep in
116     minterm_list