Commits

Sébastien Ferré committed b727549

Bug fixes and improvements about functors/expressions.

Comments (0)

Files changed (8)

     along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)
 
+module Rel = Intreln.Intmap
 module Name = Name.Make
 module Ext = Extension.Make
 module Code = Code.Make
     let path = [] in
     let backrole = ((Bwd, Rdf.uri_value), Rdf.Blank "") in (* fake backrole *)
     let _, np = expand_aux ~obs store path backrole n in
+    let blank2cpt = description_blanks_s1 [] np in
+    let blank2var =
+      let _, b2v =
+	List.fold_left
+	  (fun (vars,b2v) (n,cpt) ->
+	    if !cpt > 1
+	    then
+	      let v = get_new_var vars in
+	      v::vars, (n, (v, ref true (* first *)))::b2v
+	    else vars, b2v)
+	  ([],[]) blank2cpt in
+      b2v in
+    description_unblank_s1 blank2var np
+(*	    
     let np', _vars, _blank2var = description_vars_s1 (np,[],[]) in
     np'
-(*    description_post blank2var d *)
+*)
 and description_aux ~obs store path backrole_opt n =
   let path1 = n::path in
   let d_n = store#get_description n in
 	       Term.is_arg a ||
 	       (store#get_class Term.uri_ArgProperty)#relation#has_instance ~obs (Rdf.URI a))))
 	lrole in
-(*    let ld = [Name n] in *)
     let ld = [] in
     let ld =
       List.fold_left
       fu#relation#fold_args ~obs
 	(fun res args -> (funct,args) :: res)
 	[] n
+and description_blanks_s1 blank2cpt = function
+  | Det (Name (Rdf.Blank _ as n), f) ->
+      let blank2cpt =
+	try
+	  let cpt = List.assoc n blank2cpt in
+	  incr cpt;
+	  blank2cpt
+	with Not_found ->
+	  (n, ref 1)::blank2cpt in
+      description_blanks_p1 blank2cpt f
+  | Det (_, f) ->
+      description_blanks_p1 blank2cpt f
+  | _ -> blank2cpt
+and description_blanks_p1 blank2cpt = function
+  | Role (r,np) ->
+      description_blanks_s1 blank2cpt np
+  | Struct (funct,args) ->
+      Common.fold_for
+	(fun n res -> description_blanks_s1 res args.(n-1))
+	1 (Array.length args)
+	blank2cpt
+  | Arg (funct,i,args,st) ->
+      let blank2cpt =
+	Common.fold_for
+	  (fun n res -> if n=i then res else description_blanks_s1 res args.(n-1))
+	  1 (Array.length args)
+	  blank2cpt in
+      description_blanks_s1 blank2cpt st
+  | And l ->
+      List.fold_left
+	(fun res f -> description_blanks_p1 res f)
+	blank2cpt l
+  | _ -> blank2cpt
+and description_unblank_s1 blank2var = function
+  | Det (Name (Rdf.Blank _ as n), f) ->
+      let det =
+	try
+	  let v, first = List.assoc n blank2var in
+	  if !first
+	  then begin first := false; Qu (An, Some v) end
+	  else Ref v
+	with Not_found ->
+	  Qu (An, None) in
+      Det (det, description_unblank_p1 blank2var f)
+  | Det (det, f) ->
+      Det (det, description_unblank_p1 blank2var f)
+  | np -> np
+and description_unblank_p1 blank2var = function
+  | Role (r,np) ->
+      Role (r, description_unblank_s1 blank2var np)
+  | Struct (funct,args) ->
+      Struct (funct,
+	      Array.map (fun arg -> description_unblank_s1 blank2var arg) args)
+  | Arg (funct,i,args,st) ->
+      Arg (funct, i,
+	   Array.mapi (fun n arg -> if n = i then arg else description_unblank_s1 blank2var arg) args,
+	   description_unblank_s1 blank2var st)
+  | And l ->
+      And (List.map (fun f -> description_unblank_p1 blank2var f) l)
+  | f -> f
+(*
 and description_vars (d,vars,blank2var) =
   match d with
   | Role (r, np) ->
   | _ -> d, vars, blank2var
 and description_vars_s1 (np,vars,blank2var) =
   match np with
-  | Det (Name (Rdf.Blank _ as n), _) ->
+  | Det (Name (Rdf.Blank _ as n), f) ->
+      let f, vars, blank2var = description_vars (f,vars,blank2var) in
       (try
 	let v = List.assoc n blank2var in
-	ref_s1 v, vars, blank2var
+	Det (Ref v, f), vars, blank2var
       with _ ->
 	let v = get_new_var vars in
-	var_s1 v, v::vars, (n,v)::blank2var)
+	Det (Qu (An, Some v), f), v::vars, (n,v)::blank2var)
   | Det (Qu (An,v_opt), f) ->
       let f', vars',blank2var' = description_vars (f,vars,blank2var) in
       Det (Qu (An,v_opt), f'), vars', blank2var'
   | _ -> np, vars, blank2var
-
+*)
 
 (* answers *)
 
 		    let d_o =
 		      if o = 0
 		      then make_null
-		      else Display.display_name ~obs:Tarpit.blind_observer store (store#get_name o) in
+		      else Display.display_name_no_blank ~obs:Tarpit.blind_observer store (store#get_name o) in
 		    d_o @ `Space :: d_c)
 		  sorted_l_index)]
 (*
       List.fold_left
 	(fun res (n_opt,o) ->
 	  let sub_rel = Rel.assoc o rel in
-	  let d_n_opt = match n_opt with None -> make_null | Some n -> Display.display_name ~obs store n in
+	  let d_n_opt = match n_opt with None -> make_null | Some n -> Display.display_name_no_blank ~obs store n in
 	  fold_answers ~obs store offset limit sub_cube f res (d_n_opt::rev_line) sub_rel)
 	init sorted_key_names
   | `HIDDEN sub_cube ->
 		ext#fold (self :> Extension.store)
 		  (fun res m ->
 		    try Ext.add (self#get_entity (List.assoc var_root m)) res
-		    with _ -> prerr_endline "Lisql.ext_view#extent: root variable undefined"; res)
+		    with _ ->
+		      prerr_endline ext#string;
+		      prerr_endline "Lisql.ext_view#extent: root variable undefined";
+		      res)
 		  Ext.empty []);
 	      Hashtbl.add h_ext_views q ext_view;
 	      ext_view in

src/lisql_display.ml

 and display_s1 ~obs store k prec np =
   [`Focus (AtS1 (np,k), display_s1_aux ~obs store k prec np)]
 and display_s1_aux ~obs store k prec = function
+  | Det (Qu (An, None), Thing) -> [`Kwd "?"]
   | Det (det,f) ->
       let kf = Det1 (det,f,k) in
       let head_opt, l = split_p1 (match det with Qu _ -> true | _ -> false) kf f in
 	  [`Pair (true,
 		  display_s2 ~obs store (Det0 (det,f,k)) head_opt det @ [`Space; `Kwd "that"],
 		  [`And (List.map (fun (kx,x) -> display_p1_vp ~obs store kx prec_and x) l)])] )
-(*
-  | Det (det,Thing) -> display_s2 ~obs store (Det0 (det,Thing,k)) det
-  | Det (det,f) -> [`Pair (true,
-			   display_s2 ~obs store (Det0 (det,f,k)) det @ [`Space; `Kwd "that"],
-			   display_p1_vp ~obs store (Det1 (det,f,k)) prec_or f)]
-*)
   | NAnd l -> brackets_opt prec prec_and
 	[`And (List.map (fun (n,np1) -> display_s1 ~obs store (NAndN (n,l,k)) prec_not np1) (index_list l))]
   | NOr l -> brackets_opt prec prec_or
   | Quote s -> [`CurlyBrackets (display_s ~obs store (Quote0 (s,k)) prec_or s)]
   | Ref v -> [`Var v]
   | Qu (qu, v_opt) ->
-      display_qu qu @
-      `Space ::
       ( match head_opt with
-      | None -> [`Kwd "thing"]
+      | None ->
+	  display_qu qu @
+	  [`Space; `Kwd "thing"] @
+	  ( match v_opt with
+	  | None -> []
+	  | Some v -> [`Space; `Var v] )
       | Some (kh, (Type c as h)) ->
-	  [`Focus (AtP1 (h, kh),
-		   [`URI (c, `Class, string_of_uri ~obs store c, image_of_uri ~obs store c)])]
-      | Some (kh, (Struct _ as h)) ->
-	  [`Focus (AtP1 (h,kh),
-		   display_p1_vp_aux ~obs store kh prec_atom h)]
-      | Some _ -> assert false ) @
-      ( match v_opt with
-      | None -> []
-      | Some v -> [`Space; `Var v] )
-(*
-  | Qu (qu, None) -> display_qu qu @ [`Space; `Kwd "thing"]
-  | Qu (qu, Some v) -> display_qu qu @ [`Space; `Kwd "thing"; `Space; `Var v]
-*)
+	  display_qu qu @
+	  [`Space;
+	   `Focus (AtP1 (h, kh),
+		   [`URI (c, `Class, string_of_uri ~obs store c, image_of_uri ~obs store c)])] @
+	  ( match v_opt with
+	  | None -> []
+	  | Some v -> [`Space; `Var v] )	  
+      | Some (kh, (Struct (funct,args) as h)) ->
+	  ( match qu with
+	  | An -> []
+	  | _ -> display_qu qu @ [`Space] ) @
+	  [`Focus (AtP1 (h,kh), display_struct_arg ~obs store kh funct args None)] @
+(*		   display_p1_vp_aux ~obs store kh prec_atom h)] @ *)
+	  ( match v_opt with
+	  | None -> []
+	  | Some v -> [`Space; `Kwd "as"; `Space; `Var v] )
+      | Some _ -> assert false )
 and display_qu = function
   | An -> [`Kwd "a"]
   | Every -> [`Kwd "every"]
 	   `Tuple (display_args ~obs store k funct args arg_opt)],
 	  display_st ~obs store k funct args arg_opt)]
 and display_args ~obs store k funct args arg_opt =
-  let args' =
-    match arg_opt with
-    | None -> args
-    | Some (i,_) ->
-	let args' = Array.copy args in
-	args'.(i-1) <- ref_s1 "this";
-	args' in
   List.map
     (fun (n,np) ->
       match arg_opt with
       | None -> display_s1 ~obs store (StructN (n+1,funct,args,k)) prec_or np
       | Some (i,st) ->
-	  if i = n
+	  if i = n+1
 	  then [`Kwd "this"]
 	  else display_s1 ~obs store (ArgN (n+1,funct,i,args,st,k)) prec_or np)
     (index_list (Array.to_list args))
   match arg_opt with
   | None -> []
   | Some (i,st) -> display_s1 ~obs store (ArgT (funct,i,args,st,k)) prec_or st
+and display_name_no_blank ~obs store n =
+  match n with
+  | Rdf.Blank _ ->
+      let np = store#description ~obs n in
+      display_s1 ~obs store (default_context_of_s1 np) prec_or np
+  | _ -> display_name ~obs store n
 and display_name ~obs store n =
   match n with
   | Rdf.URI uri -> [`URI (uri, `Entity, string_of_uri ~obs store uri, image_of_uri ~obs store uri)]
 	  else string_of_uri ~obs store uri in
 	[`Typed (s, uri, s_dt)]
   | Rdf.XMLLiteral xml -> [`Xml xml]
-  | Rdf.Blank _ -> assert false
+  | Rdf.Blank id -> [`Kwd ("_:" ^ id)] (* assert false *)
 
 let of_s ~obs store s = display_s ~obs store (default_context_of_s s) prec_or s
 let of_s1 ~obs store np = display_s1 ~obs store (default_context_of_s1 np) prec_or np
 let of_p1 ~obs store f = display_p1_vp ~obs store (default_context_of_p1 f) prec_or f
 let of_p2 ~obs store r = display_p2 ~obs store (default_context_of_p2 r) prec_or r
 let of_name ~obs store n = display_name ~obs store n
+let of_name_no_blank ~obs store n = display_name_no_blank ~obs store n
 
 let of_focus ~obs store foc = of_s ~obs store (decontext_focus foc)
 

src/lisql_feature.ml

+(*
+    This file is part of SEWELIS <http://www.irisa.fr/LIS/softwares/sewelis/>
+
+    S�bastien Ferr� <ferre@irisa.fr>, �quipe LIS, IRISA/Universit� Rennes 1
+
+    Copyright 2012.
+
+    This program is free software: you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
 
 open Lisql_ast
 
   let foc' =
     let xx =
       match x with
-      | Spec_Something -> `S2 top_s2
-      | Spec_Name n -> `S2 (name_s2 n)
-      | Spec_Ref v -> `S2 (ref_s2 v)
-      | Spec_Some v -> `S2 (var_s2 v)
+      | Spec_Something -> `S1 (top_s2, top_p1)
+      | Spec_Name n ->
+	  ( match n with
+	  | Rdf.Blank _ ->
+	      ( match store#description ~obs:Tarpit.blind_observer n with 
+	      | Det (det,f) -> `S1 (det,f)
+	      | _ -> assert false )
+	  | _ -> `S1 (name_s2 n, top_p1) )
+      | Spec_Ref v -> `S1 (ref_s2 v, top_p1)
+      | Spec_Some v -> `S1 (var_s2 v, top_p1)
       | Spec_Thing -> `P1 top_p1
       | Spec_Class c -> `P1 (has_type c)
       | Spec_Role (ori,p) -> `P1 (role ori p)
       | Spec_Structure (funct,arity) -> `P1 (make_struct_arg funct arity 0)
       | Spec_Argument (funct,arity,i) -> `P1 (make_struct_arg funct arity i) in
     match xx with
-    | `S2 d ->
+    | `S1 (d,f) ->
 	( match foc with
-	| AtS _ -> Transf.focus_and_s (Is (Det (d,top_p1), top_p1)) foc
-	| AtS1 (Det (det,c),k) -> Some (AtS1 (Det (Transf.merge_s2 det d, c), k))
-	| AtS1 _ -> Transf.focus_and_s1 (Det (d,top_p1)) foc
-	| AtP1 (c, Det1 (det,_,k)) -> Some (AtP1 (c, Det1 (Transf.merge_s2 det d, c, k)))
+	| AtS _ -> Transf.focus_and_s (Is (Det (d,f), top_p1)) foc
+	| AtS1 (Det (det,_c),k) -> Some (AtS1 (Det (Transf.merge_s2 det d, f), k))
+	| AtS1 _ -> Transf.focus_and_s1 (Det (d,f)) foc
+	| AtP1 (_c, Det1 (det,_,k)) -> Some (AtP1 (f, Det1 (Transf.merge_s2 det d, f, k)))
 	| _ -> None )
     | `P1 f ->
 	( match foc with

src/lisql_semantics.ml

   let arity = Array.length args in
   Common.fold_for_down
     (fun i res ->
-      fun xargs -> fol_s1 ~obs store gv (fun xi -> res (xi::xargs)) args.(i-1))
+      fun rev_xargs -> fol_s1 ~obs store gv (fun xi -> res (xi::rev_xargs)) args.(i-1))
     arity 1
-    (fun xargs -> Prop.Atom (Fol.FFunct (funct, x, Array.of_list xargs, "")))
+    (fun rev_xargs -> Prop.Atom (Fol.FFunct (funct, x, Array.of_list (List.rev rev_xargs), "")))
     []
 
 
   Common.prof "Root.extension" (fun () ->
     let _, fol = fol_of_class ~obs store bounded_vars var_root f in
     let ext = Fol.extension_of_fol ~obs store fol in
-(*    print_endline ("Lisql.extension of: " ^ ext#string); *)
+(*print_endline ("Lisql.extension of: " ^ ext#string);*)
     ext)
 
 let extent_fold ~obs store (ff : 'a -> Extension.map -> 'a) (init : 'a) (m : Extension.map) (f : p1) : 'a =

src/lisql_syntax.ml

 (*    | "for"; _ = parse_space; np = parse_s1; _ = parse_comma; a = parse_s -> Is (np, SuchThat ("",a)) ] *)
 and parse_s1 = dcg "s1"
     [ q = parse_s2; c = OPT [ _ = parse_space; c = parse_block -> c ] ELSE Thing -> Det (q, c)
-    | c = parse_block -> Det (Qu (An, None), c)
+    | c = parse_block -> an c
     | _ = parse_left_round_bracket; np1 = parse_s1;
 	( _ = parse_and; lnp1 = LIST1 parse_s1 SEP parse_and; _ = parse_right_round_bracket -> NAnd (np1::lnp1)
         | _ = parse_or; lnp1 = LIST1 parse_s1 SEP parse_or; _ = parse_right_round_bracket -> NOr (np1::lnp1)
     | "every" -> Every
     | "only" -> Only ]
 and parse_block = dcg "block"
-    [ _ = parse_left_square_bracket; c = OPT parse_p1_seq ELSE Thing; _ = parse_right_square_bracket -> c ]
+    [ _ = parse_left_square_bracket; c = OPT parse_p1_seq ELSE Thing; _ = parse_right_square_bracket -> c
+    | funct, i_opt, args = parse_struct_arg when "" i_opt = None -> Struct (funct,args) ]
 and parse_p1_seq = dcg "p1_seq"
     [ lc = LIST1 parse_p1 SEP parse_semicolon -> match lc with [] -> Thing | [c1] -> c1 | _ -> And lc ]
 and parse_p1 = dcg "p1"
     | "not"; _ = parse_space; c1 = parse_p1 -> Not c1
     | "maybe"; _ = parse_space; c1 = parse_p1 -> Maybe c1
     | x = parse_var; _ = parse_space; "such"; _ = parse_space; "that"; _ = parse_space; s = parse_s -> SuchThat (x,s)
-    | _ = parse_is; funct = parse_uri; _ = parse_left_round_bracket; i_opt, args = parse_args when "" i_opt = None; _ = parse_right_round_bracket ->
-	Struct (funct,args)
-    | _ = parse_has; funct = parse_uri; _ = parse_left_round_bracket; i_opt, args = parse_args when "" i_opt <> None; _ = parse_right_round_bracket;
-	_ = parse_space; st = parse_s1 ->
-	  Arg (funct,Option.find i_opt,args,st) ]
+    | _ = parse_is; _ = parse_space;
+	funct, i_opt, args = parse_struct_arg when "" i_opt = None ->
+	  Struct (funct,args)
+    | _ = parse_has; _ = parse_space;
+	  funct, i_opt, args = parse_struct_arg when "" i_opt <> None;
+	  _ = parse_space; st = parse_s1 ->
+	    Arg (funct,Option.find i_opt,args,st) ]
+and parse_struct_arg = dcg "struct_arg"
+    [ funct = parse_uri;
+      _ = parse_left_round_bracket;
+      i_opt, args = parse_args;
+      _ = parse_right_round_bracket ->
+	funct, i_opt, args ]
 and parse_args = dcg "args"
     [ i_opt, l_args = parse_args_aux 1 -> i_opt, Array.of_list l_args ]
 and parse_args_aux i = dcg
     | Only -> "only" ]
 and print_block = ipp
     [ Thing -> "[]"
+    | Struct (funct,args) -> print_struct_arg of funct, None, args
     | c -> "[ "; print_p1_seq of c; " ]" ]
 and print_p1_seq = ipp
     [ Thing -> 
     | Maybe c1 -> "maybe"; print_space; print_p1 of c1
     | SuchThat (x,s) -> print_var of x; print_space; "such that"; print_space; print_s of s
     | Struct (funct,args) ->
-	"is"; print_space; print_uri of funct; "("; print_args of (None,args); ")"
+	"is"; print_space; print_struct_arg of funct, None, args
     | Arg (funct,i,args,st) ->
-	"has"; print_space; print_uri of funct; "("; print_args of (Some i,args); ")"; print_space; print_s1 of st ]
+	"has"; print_space; print_struct_arg of funct, Some i, args;
+	print_space; print_s1 of st ]
 (*
     | Pred (r,pred,args) ->
 	"at"; print_space; print_uri of r; print_space; "which"; print_space; print_uri of pred#uri;
 	MANY [ (r,c) -> print_space; "at"; print_space; print_uri of r; print_space; print_s1_c of c ] of args ]
 *)
+and print_struct_arg = ipp
+  [ funct, i_opt, args -> print_uri of funct; "("; print_args of (i_opt,args); ")" ]
 and print_args = ipp
     [ i_opt, args ->
       for l_args =

src/lisql_transf.ml

+(*
+    This file is part of SEWELIS <http://www.irisa.fr/LIS/softwares/sewelis/>
+
+    S�bastien Ferr� <ferre@irisa.fr>, �quipe LIS, IRISA/Universit� Rennes 1
+
+    Copyright 2012.
+
+    This program is free software: you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
 
 open Lisql_ast
 
   | AtS1 (Det (Name _, _), _)
   | AtS1 (Det (Quote _, _), _)
   | AtS1 (Det (Ref _, _), _)
+  | AtS1 (Det (_, Struct _), _)
   | AtS1 (_, NAndN _)
   | AtS2 _
   | AtP1 (Thing, Det1 _)
 		      f
 			~src:(store#get_name src)
 			~x:(store#get_name x)
-			~args:(Array.of_list (List.rev_map (fun arg -> store#get_name arg) rev_args))
+			~args:(Array.of_list (List.rev_map store#get_name rev_args))
 		  | _ -> assert false)
 		()
 		r1))
 	  d_x#set_functor self#uri self#arity;
 	  explicit_rel#update (fun (r1,r2) ->
 	    if not (Rel.mem tup r1)
-	    then Some (Rel.add tup r1, Rel.add (x::args@[src]) r2)
+	    then begin
+	      let r1', r2' = (Rel.add tup r1, Rel.add (x::args@[src]) r2) in
+	      Some (r1',r2') end
 	    else None)
 
 	method remove ~src m =
 	  let _args = Array.init a (fun i -> string_of_int (i+1)) in
 	  begin_tag "ext" ra;
 	  let ext_explicit = self#explicit_relation#extension ~obs _x _args _src in
-	  let ext_implicit =
-	    (store#get_property Term.uri_functorType : property)#relation#fold_successors ~obs
-	      (fun res -> function
-		| Rdf.URI uri_c ->
-		    let c : classe = store#get_class uri_c in
-		    c#relation#extension ~obs _x "" ""
-		| _ -> res)
-	      Ext.one self#name in
-	  let ext_implicit =
-	    Common.fold_for
-	      (fun i res ->
-		(store#get_property (Term.uri_functorArg i) : property)#relation#fold_successors ~obs
+	  let ext =
+	    if (store#get_class Term.uri_ImplicitFunctor : classe)#relation#has_instance ~obs self#name
+	    then
+	      let ext_implicit =
+		(store#get_property Term.uri_functorType : property)#relation#fold_successors ~obs
 		  (fun res -> function
-		    | Rdf.URI uri_pi ->
-			let p : property = store#get_property uri_pi in
-			Ext.join res (p#relation#extension ~obs _x _args.(i-1) "" "")
+		    | Rdf.URI uri_c ->
+			let c : classe = store#get_class uri_c in
+			c#relation#extension ~obs _x "" ""
 		    | _ -> res)
-		  res self#name)
-	      1 a ext_implicit in
-	  let ext = Ext.union ext_explicit ext_implicit in
+		  Ext.one self#name in
+	      let ext_implicit =
+		Common.fold_for
+		  (fun i res ->
+		    (store#get_property (Term.uri_functorArg i) : property)#relation#fold_successors ~obs
+		      (fun res -> function
+			| Rdf.URI uri_pi ->
+			    let p : property = store#get_property uri_pi in
+			    Ext.join res (p#relation#extension ~obs _x _args.(i-1) "" "")
+			| _ -> res)
+		      res self#name)
+		  1 a ext_implicit in
+	      Ext.union ext_explicit ext_implicit
+	    else ext_explicit in
 	  end_tag "ext" ra;
 	  let _largs = Array.to_list _args in
 	  match ext#relation_multi (store :> Ext.store)