-
- let rec q_where_rel n cr_r= (*function*)
- (* Some l ->*)
- let q0 =
- M.Sub
- (M.Property
- (false, M.RefineExact, ("refRel", ["position"]),
- M.RefOf(M.RVar "uri0")),
- M.VVar ("rel_position" ^ string_of_int n))
- in
- match cr_r with
- Some [] -> M.True
- | Some [(p,None)] -> q0
- | Some [(p,d)] ->
- M.And
- (q0,
- M.Sub
- (M.Property
- (false, M.RefineExact, ("refRel", ["depth"]),
- M.RefOf(M.RVar "uri0")),
- M.VVar ("rel_depth" ^ string_of_int n)))
- | Some ((p,None)::tl) ->
- M.Or
- (q0,
- q_where_rel (n+1) (Some tl))
- | Some ((p,d)::tl) ->
- M.Or
- (M.And
- (q0,
- M.Sub
- (M.Property
- (false, M.RefineExact, ("refRel", ["depth"]),
- M.RefOf(M.RVar "uri0")),
- M.VVar ("rel_depth" ^ string_of_int n))),
- q_where_rel (n+1) (Some tl))
- | None -> M.True
- in
-
- let rec q_where_sort n cr_s = (*function *)
- (* Some l ->*)
- let q0 =
- M.And
- (M.Sub
- (M.Property
- (false, M.RefineExact, ("refSort", ["position"]),
- M.RefOf(M.RVar "uri0")
- ),
- M.VVar ("sort_position" ^ string_of_int n)),
- M.Sub
- (M.Property
- (false, M.RefineExact, ("refSort", ["sort"]),
- M.RefOf(M.RVar "uri0")),
- M.VVar ("sort" ^ string_of_int n)))
- in
- match cr_s with
- Some [] -> M.True
- | Some [(p,None,s)] -> q0
-
- | Some [(p,d,s)] ->
- M.And
- (q0,
- M.Sub
- (M.Property
- (false, M.RefineExact, ("refSort", ["depth"]),
- M.RefOf(M.RVar "uri0")),
- M.VVar ("sort_depth" ^ string_of_int n)))
-
- | Some ((p,None,s)::tl) ->
- M.Or
- (q0,
- q_where_sort (n+1) (Some tl))
-
- | Some((p,d,s)::tl) ->
- M.Or
- (M.And
- (q0,
- M.Sub
- (M.Property
- (false, M.RefineExact, ("refSort", ["depth"]),
- M.RefOf(M.RVar "uri0")),
- M.VVar ("sort_depth" ^ string_of_int n))),
- q_where_sort (n+1) (Some tl))
- | None -> M.True
- in
-
-
-
-
- let q_where cr =
- let (cr_o,cr_r,cr_s) = cr in
- M.And(M.And(q_where_obj 1 cr_o, (q_where_rel 1 cr_r)), (q_where_sort 1 cr_s))
-
- in
-
-(* must restrictions *)
-
- let build_select_obj (r, pos, dep) =
- match dep with
- None -> M.Select
- ("uri",
- M.Relation (false, M.RefineExact, ("backPointer", []),
- M.Ref (M.Const [r]), [assign "p" "position"]),
- M.Ex ["uri"]
- ((M.Sub (M.Const [pos], M.Record ("uri", in_path "p")))))
- | Some dep -> let string_dep = string_of_int dep in
- M.Select
- ("uri",
- M.Relation (false, M.RefineExact, ("backPointer", []),
- M.Ref (M.Const [r]), [assign "p" "position";assign "d" "depth"]),
- M.Ex ["uri"]
- (M.And
- ((M.Sub (M.Const [pos], M.Record ("uri", in_path "p"))),
- (M.Sub (M.Const [string_dep], M.Record ("uri", in_path "d"))))))
- in
-
- let build_select_rel (pos, dep) =
- match dep with
- None -> M.Select
- ("uri",
- M.Relation (true, M.RefineExact, ("refRel", []), M.Ref (M.Const [""]), [assign "p" "position";assign "d" "depth"]),
- M.Ex ["uri"]
- (M.Sub (M.Const [pos], M.Record ("uri", in_path "p"))))
- | Some dep -> let string_dep = string_of_int dep in
- M.Select
- ("uri",
- M.Relation (true, M.RefineExact, ("refRel", []), M.Ref (M.Const [""]), [assign "p" "position";assign "d" "depth"]),
- M.Ex ["uri"]
- (M.And
- ((M.Sub (M.Const [pos], M.Record ("uri", in_path "p"))),
- (M.Sub (M.Const [string_dep], M.Record ("uri", in_path "d"))))))
- in
-
- let build_select_sort (pos, dep, sor) =
- match dep with
- None -> M.Select
- ("uri",
- M.Relation (true, M.RefineExact, ("refSort", []), M.Ref (M.Const [""]), [assign "p" "position";assign "d" "depth";assign "s" "sort"]),
- M.Ex ["uri"]
- (M.And
- ((M.Sub (M.Const [pos], M.Record ("uri", in_path "p"))),
- (M.Sub (M.Const [sor], M.Record ("uri", in_path "s"))))))
-
- | Some dep -> let string_dep = string_of_int dep in
- M.Select
- ("uri",
- M.Relation (true, M.RefineExact, ("refSort", []), M.Ref (M.Const [""]), [assign "p" "position";assign "d" "depth";assign "s" "sort"]),
- M.Ex ["uri"]
- (M.And
- ((M.And
- ((M.Sub (M.Const [pos], M.Record ("uri", in_path "p"))),
- (M.Sub (M.Const [string_dep], M.Record ("uri", in_path "d"))))),
- (M.Sub (M.Const [sor], M.Record ("uri", in_path "s"))))))
- in
-
- let rec build_intersect_obj = function
- [] -> M.Pattern (M.Const ["[.]*"])
- | [hd] -> build_select_obj hd
- | hd :: tl -> M.Intersect (build_select_obj hd, build_intersect_obj tl)
- in
-
- let rec build_intersect_rel = function
- [] -> M.Ref(M.Const [])
- | [hd] -> build_select_rel hd
- | hd :: tl -> M.Intersect (build_select_rel hd, build_intersect_rel tl)
- in
-
- let rec build_intersect_sort = function
- [] -> M.Ref(M.Const [])
- | [hd] -> build_select_sort hd
- | hd :: tl -> M.Intersect (build_select_sort hd, build_intersect_sort tl)
- in
-
- let build_intersect = function
-(* let tostring_sort (a,b,c) =
- let b1 = string_of_int b in
- (a,b1,c)
- in
- let tostring_rel (a,b) =
- let b1 = string_of_int b in
- (a,b1)
- in*)
-
-(* let (l1,l2,l3) = must in
- match (l1,l2,l3) with *)
- l1,[],[] -> build_intersect_obj l1
- | [],l2,[] -> (*let lrel = List.map tostring_rel l2 in*)
- build_intersect_rel l2
- | [],[],l3 ->(* let lsort = List.map tostring_sort l3 in*)
- build_intersect_sort l3
- | l1,l2,[] -> (*let lrel = List.map tostring_rel l2 in*)
- M.Intersect (build_intersect_obj l1, build_intersect_rel l2)
- | l1,[],l3 ->(* let lsort = List.map tostring_sort l3 in *)
- M.Intersect (build_intersect_obj l1, build_intersect_sort l3)
- | [],l2,l3 ->(* let lrel = List.map tostring_rel l2 in
- let lsort = List.map tostring_sort l3 in*)
- M.Intersect (build_intersect_rel l2, build_intersect_sort l3)
- | l1,l2,l3 ->(* let lrel = List.map tostring_rel l2 in
- let lsort = List.map tostring_sort l3 in *)
- M.Intersect (M.Intersect (build_intersect_obj l1, build_intersect_rel l2), build_intersect_sort l3)
- in
-
- let q_in = build_intersect must_use in
- let q_select = M.Select ("uri0", q_in, q_where can_use) in
-
-(* variables for can restrictions *)
-
- let q_let_u = M.LetVVar ("universe", M.Const universe, q_select) in
-
- let rec q_let_s sor n =
- match sor with
- [] -> q_let_u
- | [s] -> M.LetVVar ("sort" ^ (string_of_int n), M.Const [s], q_let_u)
- | s::tl -> M.LetVVar ("sort" ^ (string_of_int n), M.Const [s], q_let_s tl (n+1))
- in
-
-(* let q_let_s = M.LetVVar ("sorts", M.Const sor, q_let_u) in *)
-
- let rec q_let_ds sdep n =
- match sdep with
- []
- | [None] -> q_let_s sor 1
- | (None)::tl -> q_let_ds tl (n+1)
- | [Some d] -> M.LetVVar ("sort_depth" ^ (string_of_int n), M.Const [(string_of_int d)], q_let_s sor 1)
- | (Some d)::tl -> M.LetVVar ("sort_depth" ^ (string_of_int n), M.Const [(string_of_int d)], q_let_ds tl (n+1))
- in
-
-(* let q_let_ds = M.LetVVar ("sort_depths", M.Const sdep, q_let_s) in *)
-
- let rec q_let_dr rdep n =
- match rdep with
- []
- | [None] -> q_let_ds sdep 1
- | (None)::tl -> q_let_dr tl (n+1)
- | [Some d] -> M.LetVVar ("rel_depth" ^ (string_of_int n), M.Const [(string_of_int d)], q_let_ds sdep 1)
- | (Some d)::tl -> M.LetVVar ("rel_depth" ^ (string_of_int n), M.Const [(string_of_int d)], q_let_dr tl (n+1))
- in
-
-
- (*let q_let_dr = M.LetVVar ("rel_depths", M.Const rdep, q_let_ds) in*)
-
- let rec q_let_do odep n =
- match odep with
- []
- | [None] -> q_let_dr rdep 1
- | (None)::tl -> q_let_do tl (n+1)
- | [Some d] -> M.LetVVar ("obj_depth" ^ (string_of_int n), M.Const [(string_of_int d)], q_let_dr rdep 1)
- | (Some d)::tl -> M.LetVVar ("obj_depth" ^ (string_of_int n), M.Const [(string_of_int d)], q_let_do tl (n+1))
- in
-