viewcvs.cgi/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)));;
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)));;
end
1	abate	691	open Location
2			type type_fun = Types.t -> bool -> Types.t
3
4			module Unary = struct
5			module Op = struct
6			type t = (loc -> type_fun -> type_fun) * (Value.t -> Value.t)
7			end
8			module Proxy = Custom.Proxy(Custom.String)(Typer)(Op)
9			include Pool.NoHash(Proxy)
10
11			let register name make typ run ser deser =
12			Proxy.register name make
13			{ Proxy.content = (fun x -> (typ x, run x));
14			Proxy.serialize = ser;
15			Proxy.deserialize = deser };;
16
17			Typer.mk_unary_op := (fun name env -> mk (Proxy.instantiate name env));;
18			Typer.typ_unary_op := (fun i -> fst (Proxy.content (value i)));;
19			Eval.eval_unary_op := (fun i -> snd (Proxy.content (value i)));;
20			end
21
22			module Binary = struct
23			module Op = struct
24			type t = (loc -> type_fun -> type_fun -> type_fun) *
25			(Value.t -> Value.t -> Value.t)
26			end
27			module Proxy = Custom.Proxy(Custom.String)(Typer)(Op)
28			include Pool.NoHash(Proxy)
29
30			let register name make typ run ser deser =
31			Proxy.register name make
32			{ Proxy.content = (fun x -> (typ x, run x));
33			Proxy.serialize = ser;
34			Proxy.deserialize = deser };;
35
36			Typer.mk_binary_op := (fun name env -> mk (Proxy.instantiate name env));;
37			Typer.typ_binary_op := (fun i -> fst (Proxy.content (value i)));;
38			Eval.eval_binary_op := (fun i -> snd (Proxy.content (value i)));;
39			end