simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-06 03:05:28 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

added a sum type (lambda) and put point example into a module

Browse source
This commit is contained in:
Simon Cruanes 2014-02-28 21:59:19 +01:00
parent ac0ff1b5ea
commit 41d9caa830
2 changed files with 101 additions and 52 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

107
conv.ml
View file

@ -536,47 +536,76 @@ module Bencode = struct
end
end
(* test for records *)
(* tests *)
type point = {
x:int;
y:int;
color:string;
prev : point option; (* previous position, say *)
}
module Point = struct
type t = {
x : int;
y : int;
color : string;
prev : t option; (* previous position, say *)
}
let rec point_sink =
Sink.(record_fix
(fun self ->
field "x" int_ @@ fun x ->
field "y" int_ @@ fun y ->
field "color" string_ @@ fun color ->
field "prev" (opt self) @@ fun prev ->
yield_record {x;y;color;prev}
let sink =
Sink.(record_fix
(fun self ->
field "x" int_ @@ fun x ->
field "y" int_ @@ fun y ->
field "color" string_ @@ fun color ->
field "prev" (opt self) @@ fun prev ->
yield_record {x;y;color;prev}
))
let source =
Source.(record_fix
(fun self ->
field "x" (fun p -> p.x) int_ @@
field "y" (fun p -> p.y) int_ @@
field "color" (fun p -> p.color) string_ @@
field "prev" (fun p -> p.prev) (opt self) @@
record_stop
))
let p = {x=1; y=42; color="yellow";
prev = Some {x=1; y=41; color="red"; prev=None};}
let p2 = into source Json.sink p
let p3 = from Json.source sink p2
let p4 = into source Json.sink p3
let p2_sexp = into source Sexp.sink p
let p3_sexp = from Sexp.source sink p2_sexp
let p4_sexp = into source Sexp.sink p3_sexp
end
module Lambda = struct
type t =
| Var of string
| App of t * t
| Lambda of string * t
let source = Source.(sum_fix
(fun self t -> match t with
| Var s -> "var", sum_cons string_ s @@ sum_nil
| App (t1, t2) -> "app", sum_cons self t1 @@ sum_cons self t2 @@ sum_nil
| Lambda (s, t) -> "lam", sum_cons string_ s @@ sum_cons self t @@ sum_nil
))
let sink = Sink.(sum_fix
(fun self str -> match str with
| "var" -> string_ |+| fun s -> yield (Var s)
| "app" -> self |+| fun t1 -> self |+| fun t2 -> yield (App (t1, t2))
| "lam" -> string_ |+| fun s -> self |+| fun t -> yield (Lambda (s, t))
| _ -> __error "expected lambda term"
))
let t1 = Lambda ("x", App (Lambda ("y", App (Var "y", Var "x")), Var "x"))
let point_source : point Source.t =
Source.(record_fix
(fun self ->
field "x" (fun p -> p.x) int_ @@
field "y" (fun p -> p.y) int_ @@
field "color" (fun p -> p.color) string_ @@
field "prev" (fun p -> p.prev) (opt self) @@
record_stop
))
let p = {x=1; y=42; color="yellow";
prev = Some {x=1; y=41; color="red"; prev=None};}
let p2 = into point_source Json.sink p
let p3 = from Json.source point_sink p2
let p4 = into point_source Json.sink p3
let p2_sexp = into point_source Sexp.sink p
let p3_sexp = from Sexp.source point_sink p2_sexp
let p4_sexp = into point_source Sexp.sink p3_sexp
let t1_json = into source Json.sink t1
let t1_bencode = into source Bencode.sink t1
let t1_sexp = into source Sexp.sink t1
end

46
conv.mli
View file

@ -238,19 +238,39 @@ module Bencode : sig
val sink : t Sink.universal
end
type point = {
x:int;
y:int;
color:string;
prev : point option; (* previous position, say *)
}
(** Tests *)
val point_source : point Source.t
val point_sink : point Sink.t
module Point : sig
type t = {
x : int;
y : int;
color : string;
prev : t option; (* previous position, say *)
}
val p : point
val p2 : Json.t
val p4 : Json.t
val source : t Source.t
val sink : t Sink.t
val p2_sexp : Sexp.t
val p4_sexp : Sexp.t
val p : t
val p2 : Json.t
val p4 : Json.t
val p2_sexp : Sexp.t
val p4_sexp : Sexp.t
end
module Lambda : sig
type t =
| Var of string
| App of t * t
| Lambda of string * t
val source : t Source.t
val sink : t Sink.t
val t1 : t
val t1_json : Json.t
val t1_bencode : Bencode.t
val t1_sexp : Sexp.t
end