[r2004-07-08 15:50:08 by afrisch] Clean up: delete old system for operators

Original author: afrisch
Date: 2004-07-08 15:51:05+00:00

compile/compile.ml

@@ -79,8 +79,6 @@ and compile_aux env tail = function
   | Typed.RemoveField (e,l) -> RemoveField (compile env tail e,l)
   | Typed.Dot (e,l) -> Dot (compile env tail e, l)
   | Typed.Try (e,brs) -> Try (compile env false e, compile_branches env tail brs)
-  | Typed.UnaryOp (op,e) -> UnaryOp (op, compile env tail e)
-  | Typed.BinaryOp (op,e1,e2) -> BinaryOp (op, compile env false e1, compile env tail e2)
   | Typed.Ref (e,t) ->  Ref (compile env tail e, t)
   | Typed.External (t,i) -> 
       (match env.cu with
@@ -92,6 +90,8 @@ and compile_aux env tail = function
 	| arg::l -> (compile env false arg) :: (aux l)
 	| [] -> [] in
       Op (op, aux args)
+  | Typed.NsTable (ns,e) ->
+      NsTable (ns, compile_aux env tail e)
 
 and compile_abstr env a =
   let fun_env = 

compile/lambda.ml

@@ -58,10 +58,9 @@ type expr =
   | Validate of expr * schema_component_kind * string * U.t
   | RemoveField of expr * label
   | Dot of expr * label
-  | UnaryOp of int * expr
-  | BinaryOp of int * expr * expr
   | Ref of expr * Types.Node.t
   | Op of string * expr list
+  | NsTable of Ns.table * expr
 
 and branches = {
   brs: (Patterns.node * expr) list;
@@ -198,15 +197,6 @@ module Put = struct
 	bits nbits s 15;
 	expr s e;
 	LabelPool.serialize s l
-    | UnaryOp (op,e) ->
-	bits nbits s 16;
-	!unary_op s op;
-	expr s e
-    | BinaryOp (op,e1,e2) ->
-	bits nbits s 17;
-	!binary_op s op;
-	expr s e1;
-	expr s e2
     | Ref (e,t) ->
 	bits nbits s 18;
 	expr s e;
@@ -215,6 +205,10 @@ module Put = struct
 	bits nbits s 19;
 	string s op;
 	list expr s args
+    | NsTable (ns,e) ->
+	bits nbits s 20;
+	Ns.serialize_table s ns;
+	expr s e
 	  
   and branches s brs =
     list (pair Patterns.Node.serialize expr) s brs.brs;
@@ -319,15 +313,6 @@ module Get = struct
 	  let e = expr s in
 	  let l = LabelPool.deserialize s in
 	  Dot (e,l)
-      | 16 ->
-	  let op = !unary_op s in
-	  let e = expr s in
-	  UnaryOp (op,e)
-      | 17 ->
-	  let op = !binary_op s in
-	  let e1 = expr s in
-	  let e2 = expr s in
-	  BinaryOp (op,e1,e2)
       | 18 ->
 	  let e = expr s in
 	  let t = Types.Node.deserialize s in
@@ -336,6 +321,10 @@ module Get = struct
 	  let op = string s in
 	  let args = list expr s in
 	  Op (op,args)
+      | 20 ->
+	  let ns = Ns.deserialize_table s in
+	  let e = expr s in
+	  NsTable (ns,e)
       | _ -> assert false
 
   and branches s =

compile/lambda.mli

@@ -31,10 +31,9 @@ type expr =
   | Validate of expr * schema_component_kind * string * U.t
   | RemoveField of expr * label
   | Dot of expr * label
-  | UnaryOp of int * expr
-  | BinaryOp of int * expr * expr
   | Ref of expr * Types.Node.t
-  | Op of string * expr list
+  | Op of string * expr list  (* the string is replaced at runtime by eval function *)
+  | NsTable of Ns.table * expr
 
 and branches = {
   brs: (Patterns.node * expr) list;

compile/operators.ml

 open Location
 type type_fun = Types.t -> bool -> Types.t
 
-module Unary = struct
-  module Op = struct
-    type t = (loc -> type_fun -> type_fun) * (Value.t -> Value.t)
-  end
-  module Proxy = Custom.Proxy(Custom.String)(Typer)(Op)
-  include Pool.NoHash(Proxy)
-
-  let register name make typ run ser deser =
-    Proxy.register name make
-      { Proxy.content = (fun x -> (typ x, run x));
-	Proxy.serialize = ser;
-	Proxy.deserialize = deser };;
-      
-  Typer.mk_unary_op := (fun name env -> mk (Proxy.instantiate name env));;
-  Typer.typ_unary_op := (fun i -> fst (Proxy.content (value i)));;
-  Eval.eval_unary_op := (fun i -> snd (Proxy.content (value i)));;
-  Lambda.Put.unary_op := serialize;;
-  Lambda.Get.unary_op := deserialize;;
-end
-
-module Binary = struct
-  module Op = struct
-    type t = (loc -> type_fun -> type_fun -> type_fun) * 
-	(Value.t -> Value.t -> Value.t)
-  end
-  module Proxy = Custom.Proxy(Custom.String)(Typer)(Op)
-  include Pool.NoHash(Proxy)
-
-  let register name make typ run ser deser =
-    Proxy.register name make
-      { Proxy.content = (fun x -> (typ x, run x));
-	Proxy.serialize = ser;
-	Proxy.deserialize = deser };;
-      
-  Typer.mk_binary_op := (fun name env -> mk (Proxy.instantiate name env));;
-  Typer.typ_binary_op := (fun i -> fst (Proxy.content (value i)));;
-  Eval.eval_binary_op := (fun i -> snd (Proxy.content (value i)));;
-  Lambda.Put.binary_op := serialize;;
-  Lambda.Get.binary_op := deserialize;;
-end
-
-
 let register op arity typ eval =
   Typer.register_op op arity typ;
   Eval.register_op op eval
@@ -62,7 +20,7 @@ let register_unary op typ eval =
     )
 
 let register_binary op typ eval =
-  register op 1
+  register op 2
     (function
        | [ tf1; tf2 ] -> 
 	   typ tf1 tf2
@@ -94,3 +52,8 @@ let register_op op ?(expect=Types.any) typ eval =
   register_unary op 
     (fun tf _ _ -> let t = tf expect true in typ t)
     eval
+
+let register_op2 op t1 t2 s eval =
+  register_binary op
+    (fun tf1 tf2 _ _ -> ignore (tf1 t1 false); ignore (tf2 t2 false); s)
+    eval

compile/operators.mli

 open Location
 type type_fun = Types.t -> bool -> Types.t
 
-module Unary: sig
-  include Custom.T with type t = int
-
-  val register: 
-    string -> 
-    (Typer.t -> 'a) ->
-    ('a -> loc -> type_fun -> type_fun) ->
-    ('a -> Value.t -> Value.t) ->
-    ('a Serialize.Put.f) ->
-    ('a Serialize.Get.f) -> unit
-end
-
-
-module Binary: sig
-  include Custom.T with type t = int
-
-  val register: 
-    string -> 
-    (Typer.t -> 'a) ->
-    ('a -> loc -> type_fun -> type_fun -> type_fun) ->
-    ('a -> Value.t -> Value.t -> Value.t) ->
-    ('a Serialize.Put.f) ->
-    ('a Serialize.Get.f) -> unit
-end
-
-
 val register: 
   string -> int -> (type_fun list -> type_fun) -> (Value.t list -> Value.t) -> unit
 
@@ -36,5 +10,9 @@ val register_binary:
   string -> (type_fun -> type_fun -> type_fun) -> (Value.t -> Value.t -> Value.t) -> unit
 
 val register_fun: string -> Types.t -> Types.t -> (Value.t -> Value.t) -> unit
+
 val register_op: 
   string -> ?expect:Types.t -> (Types.t -> Types.t) -> (Value.t -> Value.t) -> unit
+
+val register_op2: 
+  string -> Types.t -> Types.t -> Types.t -> (Value.t -> Value.t -> Value.t) -> unit

driver/cduce.ml

@@ -343,16 +343,13 @@ let eval s =
     print_exn ppf exn;
     Format.fprintf ppf "@.";
     Value.failwith' (Buffer.contents b)
+	   
 
-
-let () =
+let () =        
   Operators.register_fun "eval_expr" Builtin_defs.string_latin1 Types.any
-    (fun v ->
-       match eval (Value.cduce2ocaml_string v) with
-	 | [ (None,v) ] -> v
-	 | _ -> Value.failwith' "eval: the string must evaluate to a single value"
-    )
+  (fun v ->
+     match eval (Value.cduce2ocaml_string v) with
+       | [ (None,v) ] -> v
+       | _ -> Value.failwith' "eval: the string must evaluate to a single value"
+  )
 
-	   
-       
-  

parser/ast.ml

@@ -70,7 +70,7 @@ and pexpr =
   (* Other *)
   | NamespaceIn of U.t * Ns.t * pexpr
   | Forget of pexpr * ppat    
-  | Op of string * pexpr list
+(*  | Op of string * pexpr list *)
   | Ref of pexpr * ppat
   | External of string * ppat list
 

parser/parser.ml

@@ -88,6 +88,9 @@ let if_then_else cond e1 e2 = Match (cond, [pat_true,e1; pat_false,e2])
 let logical_and e1 e2 = if_then_else e1 e2 cst_false
 let logical_or e1 e2 = if_then_else e1 cst_true e2
 let logical_not e = if_then_else e cst_false cst_true
+
+let apply_op2_noloc op e1 e2 = Apply (Apply (Var (parse_ident op), e1), e2)
+let apply_op2 loc op e1 e2 = exp loc (apply_op2_noloc op e1 e2)
  
 
 EXTEND
@@ -240,18 +243,17 @@ EXTEND
 	  | "<<" -> "<"
 	  | ">>" -> ">"
 	  | s -> s in
-	exp loc (Op (op,[e1;e2]))
+	apply_op2 loc op e1 e2
     ]
 
     | 
-    [ e1 = expr; op = ["+" | "-" | "@" ]; e2 = expr -> 
-	exp loc (Op (op,[e1;e2]))
+    [ e1 = expr; op = ["+" | "-" | "@" ]; e2 = expr -> apply_op2 loc op e1 e2
     | e1 = expr; "||"; e2 = expr -> exp loc (logical_or e1 e2)
     | e = expr; "\\"; l = [IDENT | keyword ] -> 
 	exp loc (RemoveField (e, label l)) 
     ]
     |
-    [ e1 = expr; op = ["*"]; e2 = expr -> exp loc (Op (op,[e1;e2]))  
+    [ e1 = expr; op = ["*"]; e2 = expr -> apply_op2 loc op e1 e2
     | e1 = expr; "&&"; e2 = expr -> exp loc (logical_and e1 e2)
     | e = expr; op = "/"; p = pat LEVEL "simple" ->
 	let tag = mk loc (Internal (Types.atom (Atoms.any))) in
@@ -267,14 +269,9 @@ EXTEND
     [ e = expr;  "."; l = [IDENT | keyword ] -> 
 	exp loc (Dot (e, label l)) 
     ]  
-    |
-    [ op = [ IDENT "print_xml" | IDENT "print_xml_utf8"
-	   ]; 
-      e = expr -> exp loc (Op (op,[e]))
-    | op = [ IDENT "dump_to_file" | IDENT "dump_to_file_utf8" ];
-      e1 = expr LEVEL "no_appl"; e2 = expr -> exp loc (Op (op, [e1;e2])) 
-    | e1 = SELF; IDENT "div"; e2 = expr -> exp loc (Op ("/", [e1;e2]))
-    | e1 = SELF; IDENT "mod"; e2 = expr -> exp loc (Op ("mod", [e1;e2]))
+    | [ 
+      e1 = SELF; IDENT "div"; e2 = expr -> apply_op2 loc "/" e1 e2
+    | e1 = SELF; IDENT "mod"; e2 = expr -> apply_op2 loc "mod" e1 e2
     | e1 = SELF; e2 = expr -> exp loc (Apply (e1,e2))
     ]
 
@@ -291,7 +288,7 @@ EXTEND
 		     match x with
 		       | `String (loc,i,j,s) -> exp loc (String (i,j,s,q))
 		       | `Elems ((loc,_),x) -> exp (loc,loc_end) (Pair(x,q))
-		       | `Explode x -> Op ("@",[x;q])
+		       | `Explode x -> apply_op2_noloc "@" x q
 		  ) l e
 	in
 	exp loc l

query/query.ml

@@ -128,8 +128,6 @@ let rec string_of_pexpr x =
    in match x with   
        | Integer i -> string_of_int(Intervals.V.get_int(i)) 
        | Atom a  -> "`" ^ U.get_str ( a)
-       | Op(op,[e1;e2]) -> string_of_pexpr e1 ^ " " ^ op^ " " ^ string_of_pexpr e2
-       | Op(op,[e1]) -> op^ "(" ^ string_of_pexpr e1^") "
        | Var( s) ->  U.get_str (s) 
        | Xml(e1,e2) -> " <" ^ string_of_pexpr e1 ^ ">" ^ string_of_pexpr e2 
        | Pair(e1,e2) -> "(" ^ string_of_pexpr e1 ^ "," ^ string_of_pexpr e2 ^ ")"
@@ -157,8 +155,6 @@ let rec string_of_pexpr x =
 let rec var_of_pexpr x =
 match x with
         LocatedExpr(_,x) -> var_of_pexpr x
-       |Op(_,[e1;e2]) -> var_of_pexpr e1 @ var_of_pexpr e2
-       |Op(_,[e1]) -> var_of_pexpr e1 
        |Var(s) -> [ident s]
        |Pair(e1,e2) -> var_of_pexpr e1 @ var_of_pexpr e2
        |Apply(e1,e2) ->  var_of_pexpr e2

query/query_parse.ml

@@ -24,6 +24,8 @@ let rec multi_prod loc = function
 
 let if_then_else cond e1 e2 = Match (cond, [pat_true,e1; pat_false,e2])
 
+let op2 op e1 e2 = Apply (Apply (Var (U.mk op), e1), e2)
+
 EXTEND 
   GLOBAL: expr pat keyword;
 
@@ -58,8 +60,7 @@ EXTEND
      | e = expr; "//" ; p = pat -> (* projections sur tous les descendants *)
        let assign= 
        exp loc ( Apply (Dot (Var(U.mk"$stack"), U.mk"set"),
-           (Op("@",
-	  [(Apply(Dot(Var(U.mk"$stack"),U.mk"get"),cst_nil));Pair(Var(U.mk"$$$"),cst_nil)]))))
+           (op2 "@" (Apply(Dot(Var(U.mk"$stack"),U.mk"get"),cst_nil)) (Pair(Var(U.mk"$$$"),cst_nil)))))
        in let branche=Pair(Var (Id.value id_dummy),cst_nil)
        in let branches= exp loc (Match(assign,[pat_nil,branche]))
        in let xt=exp loc (Xtrans (e,[(mk loc(And(mk loc(PatVar(U.mk "$$$")),p))),branches]))
@@ -100,8 +101,7 @@ EXTEND
 	      fun_body = [
              ( mk loc(Prod(mk loc(PatVar(s)),mk loc(Regexp(Elem(mk loc(PatVar(h))),
 	     mk loc(PatVar(t)))))),
-              exp loc (if_then_else (exp loc (Op("=", [(exp loc (Var (s)));(exp loc
-	      (Var (h)))]))) cst_true (exp loc( Apply(exp loc (Var(U.mk "member")),
+              exp loc (if_then_else (op2 "=" (Var s) (Var h)) cst_true (exp loc( Apply(exp loc (Var(U.mk "member")),
 	      exp loc(Pair(exp loc (Var (s)),exp loc (Var(t)))))))));(any, cst_false)]} in
         let e = exp loc (Abstraction abst) in
         (( exp loc (Match (e,[p,exp loc(Apply( exp loc
@@ -130,7 +130,7 @@ EXTEND
          fun_iface = [multi_prod loc [mk loc (Regexp(Star(Elem(int)),pat_nil)); int],int]; 
          fun_body = [
 	    (mk loc ( Prod(mk loc(Regexp(Elem(mk loc(PatVar(h))),mk loc(PatVar(t)))),mk loc(PatVar(a)))),
-             exp loc(if_then_else (exp loc (Op(">",[(exp loc (Var (a)));(exp loc (Var (h)))])))
+             exp loc(if_then_else (op2 ">" (Var a) (Var h))
 	     (exp loc( Apply(exp loc (Var(U.mk "aux")),
 	      exp loc(Pair(exp loc (Var (t)),exp loc (Var(h)))))))
 	     (exp loc( Apply(exp loc (Var(U.mk "aux")),
@@ -176,7 +176,7 @@ EXTEND
          fun_iface = [multi_prod loc [mk loc (Regexp(Star(Elem(int)),pat_nil)); int],int]; 
          fun_body = [
 	    (mk loc ( Prod(mk loc(Regexp(Elem(mk loc(PatVar(h))),mk loc(PatVar(t)))),mk loc(PatVar(a)))),
-             exp loc(if_then_else (exp loc (Op("<",[(exp loc (Var (a)));(exp loc (Var (h)))])))
+             exp loc(if_then_else (op2 "<" (Var a) (Var h))
 	     (exp loc( Apply(exp loc (Var(U.mk "aux")),
 	      exp loc(Pair(exp loc (Var (t)),exp loc (Var(h)))))))
 	     (exp loc( Apply(exp loc (Var(U.mk "aux")),
@@ -223,7 +223,7 @@ EXTEND
          fun_body = [
 	    (mk loc ( Prod(mk loc(Regexp(Elem(mk loc(PatVar(h))),mk loc(PatVar(t)))),mk loc(PatVar(a)))),
              (exp loc( Apply(exp loc (Var(U.mk "aux")),
-	      exp loc(Pair(exp loc (Var (t)),exp loc (Op("+",[(exp loc (Var (a)));(exp loc (Var (h)))]))))))) 
+	      exp loc(Pair(exp loc (Var (t)), op2 "+" (Var a) (Var h))))))
 	     );
 	    (mk loc ( Prod(any,mk loc(PatVar(a)))),exp loc (Var(a))) ]} in
          

runtime/eval.ml

@@ -3,8 +3,7 @@ open Run_dispatch
 open Ident
 open Lambda
 
-let eval_unary_op = ref (fun _ -> assert false)
-let eval_binary_op = ref (fun _ _ -> assert false)
+let ns_table = ref Ns.empty_table
 
 let ops = Hashtbl.create 13
 let register_op = Hashtbl.add ops
@@ -124,14 +123,19 @@ let rec eval env = function
   | Transform (arg,brs) -> eval_transform env brs (eval env arg) 
   | Dot (e, l) -> eval_dot l (eval env e)
   | RemoveField (e, l) -> eval_remove_field l (eval env e)
-  | UnaryOp (op,e) -> !eval_unary_op op (eval env e)
-  | BinaryOp (op,e1,e2) ->  
-      let v1 = eval env e1 in
-      let v2 = eval env e2 in
-      !eval_binary_op op v1 v2
   | Validate (e, kind, schema, name) -> eval_validate env e kind schema name
   | Ref (e,t) -> eval_ref env e t
-  | Op (op,args) -> eval_op op (List.map (eval env) args)
+  | Op (op,args) as e -> 
+      let args = List.map (eval env) args in
+      (* eval_op op args *)
+      if Obj.tag (Obj.repr op) = Obj.string_tag then
+	let eval_fun = eval_op op in
+	Obj.set_field (Obj.repr e) 0 (Obj.repr eval_fun);
+	eval_fun args
+      else 
+	(Obj.magic op) args
+  | NsTable (ns,e) -> ns_table := ns; eval env e
+      
 
 and eval_abstraction env slots iface body =
   let local_env = Array.map (eval_var env) slots in

runtime/eval.mli

@@ -2,8 +2,8 @@ open Value
 open Ident
 open Lambda
 
-val eval_unary_op: (int -> (t -> t)) ref
-val eval_binary_op : (int -> (t -> t -> t)) ref
+val ns_table: Ns.table ref
+
 val register_op: string -> (t list -> t) -> unit
 
 val get_global: (Types.CompUnit.t -> int -> t) ref

types/builtin.ml

@@ -35,14 +35,7 @@ let env =
 
 open Operators
 
-let binary_op_gen name typ run =
-  Binary.register name 
-    (fun _ -> ())
-    (fun () -> typ)
-    (fun () -> run)
-    (fun s () -> ())
-    (fun s -> ())
-
+let binary_op_gen = register_binary
 
 let unary_op_gen = register_unary
 
@@ -50,25 +43,20 @@ let unary_op_gen = register_unary
 let binary_op name t1 t2 f run =
   binary_op_gen
     name
-    (fun loc arg1 arg2 constr precise ->
+    (fun arg1 arg2 constr precise ->
        f (arg1 t1 true) (arg2 t2 true))
     run
 
-let binary_op_cst name t1 t2 t run =
-  binary_op_gen name
-    (fun loc arg1 arg2 constr precise ->
-       ignore (arg1 t1 false); 
-       ignore (arg2 t2 false); 
-       t)
-    run
+let binary_op_cst = register_op2
+
 
 let binary_op_warning2 name t1 t2 w2 t run =
   binary_op_gen name
-    (fun loc arg1 arg2 constr precise ->
+    (fun arg1 arg2 constr precise ->
        ignore (arg1 t1 false); 
        let r = arg2 t2 true in
        if not (Types.subtype r w2) then
-	 Typer.warning loc "This operator may fail";
+	 raise (Typer.Warning ("This operator may fail", t));
        t)
     run
 
@@ -192,23 +180,13 @@ register_fun "argv" nil (Sequence.star string_latin1)
      !argv);;
 
 
-Unary.register "print_xml"
-  (fun tenv -> Typer.get_ns_table tenv)
-  (fun ns_table loc arg constr precise -> 
-     ignore (arg Types.any false);
-     string_latin1)
-  (Print_xml.print_xml ~utf8:false)
-  Ns.serialize_table
-  Ns.deserialize_table;;
-
-Unary.register "print_xml_utf8"
-  (fun tenv -> Typer.get_ns_table tenv)
-  (fun ns_table loc arg constr precise -> 
-     ignore (arg Types.any false);
-     string)
-  (Print_xml.print_xml ~utf8:true)
-  Ns.serialize_table
-  Ns.deserialize_table;;
+register_fun "print_xml" 
+  Types.any string_latin1
+  (fun v -> Print_xml.print_xml ~utf8:false !Eval.ns_table v);;
+
+register_fun "print_xml_utf8" 
+  Types.any string
+  (fun v -> Print_xml.print_xml ~utf8:true !Eval.ns_table v);;
 
 register_fun "print"
   string_latin1 nil
@@ -264,7 +242,7 @@ binary_op_cst "dump_to_file_utf8"
 (* Integer operators *)
 
 binary_op_gen "+"
-  (fun loc arg1 arg2 constr precise ->
+  (fun arg1 arg2 constr precise ->
      let t1 = arg1 (Types.cup int Types.Record.any) true in
      if Types.subtype t1 int 
      then (
@@ -277,7 +255,7 @@ binary_op_gen "+"
        let t2 = arg2 Types.Record.any true in 
        Types.Record.merge t1 t2
      )
-     else Typer.error loc "The first argument mixes integers and records")
+     else raise (Typer.Error "The first argument mixes integers and records"))
   (fun v1 v2 -> match (v1,v2) with
      | (Value.Integer x, Value.Integer y) -> Value.Integer (Intervals.V.add x y)
      | (Value.Record r1, Value.Record r2) -> Value.Record (LabelMap.merge (fun x y -> y) r1 r2)
@@ -312,7 +290,7 @@ binary_op_cst "mod"
 
 
 binary_op_gen "@"
-  (fun loc arg1 arg2 constr precise ->
+  (fun arg1 arg2 constr precise ->
      let constr' = Sequence.star 
 		     (Sequence.approx (Types.cap Sequence.any constr)) in
      let exact = Types.subtype constr' constr in
@@ -336,4 +314,3 @@ unary_op_gen "flatten"
 
 register_fun "raise" any Types.empty
   (fun v -> raise (Value.CDuceExn v));;
-

typing/typed.ml

@@ -49,11 +49,10 @@ and  texpr' =
   (* Exception *)
   | Try of texpr * branches
 
-  | UnaryOp of int * texpr
-  | BinaryOp of int * texpr * texpr
   | Ref of texpr * ttyp
   | External of Types.t * int
   | Op of string * int * texpr list
+  | NsTable of Ns.table * texpr'
 
 and abstr = { 
   fun_name : id option; 

typing/typer.ml

@@ -843,12 +843,6 @@ let pat env p =
 
 
 type type_fun = Types.t -> bool -> Types.t
-let typ_cst = ref (fun _ -> assert false)
-let mk_unary_op = ref (fun _ _ -> assert false)
-let typ_unary_op = ref (fun _ _ _ -> assert false)
-let mk_binary_op = ref (fun _ _ -> assert false)
-let typ_binary_op = ref (fun _ _ _ _ -> assert false)
-
 
 module Fv = IdSet
 
@@ -913,15 +907,6 @@ let rec expr env loc = function
   | String (i,j,s,e) ->
       let (fv,e) = expr env loc e in
       exp loc fv (Typed.String (i,j,s,e))
-  | Op (op,le) ->
-      let (fvs,ltes) = List.split (List.map (expr env loc) le) in
-      let fv = List.fold_left Fv.cup Fv.empty fvs in
-      (try
-	 (match ltes with
-	    | [e] -> exp loc fv (Typed.UnaryOp (!mk_unary_op op env, e))
-	    | [e1;e2] -> exp loc fv (Typed.BinaryOp (!mk_binary_op op env, e1,e2))
-	    | _ -> assert false)
-       with Not_found -> assert false)
   | Match (e,b) -> 
       let (fv1,e) = expr env loc e
       and (fv2,b) = branches env b in
@@ -964,7 +949,11 @@ and extern loc env s args =
     
 and var env loc s =
   match is_op env s with
-    | Some (s,arity) -> exp loc Fv.empty (Typed.Op (s, arity, []))
+    | Some (s,arity) -> 
+	let need_ns = s = "print_xml" || s = "print_xml_utf8" in
+	let e = Typed.Op (s, arity, []) in
+	let e = if need_ns then Typed.NsTable (env.ns,e) else e in
+	exp loc Fv.empty e
     | None ->
 	match Ns.split_qname s with
 	  | "", id -> 
@@ -1175,15 +1164,6 @@ and type_check' loc env e constr precise = match e with