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)));;
  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 typ eval =
  Typer.register_op op typ;
  Eval.register_op op eval
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	abate	694	Lambda.Put.unary_op := serialize;;
21			Lambda.Get.unary_op := deserialize;;
22	abate	691	end
23
24			module Binary = struct
25			module Op = struct
26			type t = (loc -> type_fun -> type_fun -> type_fun) *
27			(Value.t -> Value.t -> Value.t)
28			end
29			module Proxy = Custom.Proxy(Custom.String)(Typer)(Op)
30			include Pool.NoHash(Proxy)
31
32			let register name make typ run ser deser =
33			Proxy.register name make
34			{ Proxy.content = (fun x -> (typ x, run x));
35			Proxy.serialize = ser;
36			Proxy.deserialize = deser };;
37
38			Typer.mk_binary_op := (fun name env -> mk (Proxy.instantiate name env));;
39			Typer.typ_binary_op := (fun i -> fst (Proxy.content (value i)));;
40			Eval.eval_binary_op := (fun i -> snd (Proxy.content (value i)));;
41	abate	694	Lambda.Put.binary_op := serialize;;
42			Lambda.Get.binary_op := deserialize;;
43	abate	691	end
44	abate	1237
45
46			let register op typ eval =
47			Typer.register_op op typ;
48			Eval.register_op op eval