Skip to content

Instantly share code, notes, and snippets.

@keigoi keigoi/lens.ts
Last active Nov 9, 2018

Embed
What would you like to do?
lens typescript
function id<A>(x:A): A {
return x;
}
abstract class Lens<V1, V2, S1, S2> {
abstract get(s: S1): V1;
abstract put(s: S1, v:V2) : S2
}
class Pair<A, B> {
constructor(a: A, b: B) {
this.fst = a;
this.snd = b;
}
fst: A;
snd: B;
}
class FstLens<A1, A2, B> extends Lens<A1, A2, Pair<A1, B>, Pair<A2, B2>>
{
get(s: Pair<A1, B>): A1 {
return s.fst
}
put(s: Pair<A1, B>, v: A2): Pair<A2, B> {
return new Pair<A2,B>(v, s.snd)
}
}
function fstlens<A1, A2, B>() {
return new FstLens<A1, A2, B>()
}
function get<V1, V2, S1, S2>(l: Lens<V1, V2, S1, S2>, s: S1) : V1 {
return l.get(s)
}
function main() {
//var fst : FstLens<number,number,number> = fstlens();
var fst = fstlens();
var intPair = new Pair<number,number>(1,2);
// var strPair = new Pair("abc", "def");
// var x = fst.get(intPair) + fst.get(intPair); // NG
var x = fstlens().get(intPair) + fstlens().get(intPair);
}
(* paste this into https://try.ocamlpro.com/js_of_ocaml/
* then you can see types
*)
(* from https://github.com/keigoi/ocaml-mpst/blob/master/light/light.ml *)
module Channel : sig
type 'a t
val create : unit -> 'a t
val send : 'a t -> 'a -> unit
val recv : 'a t -> 'a
val choose : ('a t * 'b) list -> 'a * 'b
end = struct
type 'a t = unit
let create () = ()
let send t v = failwith "fail"
let recv t = failwith "fail"
let choose xs = failwith "fail"
(* type 'a t = 'a Event.channel
* let create () = Event.new_channel ()
* let send t v = Event.sync (Event.send t v)
* let recv t = Event.sync (Event.receive t)
* let choose xs =
* Event.sync (Event.choose (List.map (fun (t,a) -> Event.wrap (Event.receive t) (fun v -> v,a)) xs)) *)
end
(* module Local = struct *)
type ('a,'b) either = Left of 'a | Right of 'b
type ('v1,'v2,'s1,'s2) lens = {get : 's1 -> 'v1; put : 's1 -> 'v2 -> 's2}
type ('r,'v1,'v2,'s1,'s2) role = {role:'r; lens:('v1,'v2,'s1,'s2) lens; merge: 's2 -> 's2 -> 's2}
type ('c,'v,'r) send = Send of 'r * 'v Channel.t * 'c list
type ('c,'v,'r) recv = Recv of 'r * 'v Channel.t * 'c list
type ('c1,'c2,'r) select = Select of 'r * bool Channel.t * 'c1 list * 'c2 list
type ('c1,'c2,'r) branch = Branch of 'r * bool Channel.t * 'c1 list * 'c2 list
type close = Close
type 'c sess = Sess of 'c list
let send (_:'r) v (Sess s) =
match s with
| [Send ((_:'r),ch,cont)] ->
Channel.send ch v;
Sess cont
| _ -> failwith "role not enabled"
let receive (_:'r) (Sess s) =
let xs = List.map (fun (Recv ((_:'r), ch, c)) -> ch, c) s in
let v,cont = Channel.choose xs in
v, Sess cont
let _select b (_:'r) (Sess s) =
match s with
| [Select ((_:'r),ch,ls,rs)] ->
Channel.send ch b;
(ls,rs)
| _ -> failwith "role not enabled"
let select_left r s = Sess (fst (_select true r s))
let select_right r s = Sess (snd (_select false r s))
let branch (_:'r) (Sess s) =
let xs = List.map (fun (Branch ((_:'r),ch,ls,rs)) -> (ch,(ls,rs))) s in
let b, (ls,rs) = Channel.choose xs in
if b then
Left (Sess ls)
else
Right (Sess rs)
let close (Sess (_:close list)) = ()
(* end
*
* module Global = struct
* open Local *)
let (-->) a b s =
let ch = Channel.create () in
let (Sess sa) = a.lens.get s in
let s = a.lens.put s (Sess [Send (b.role, ch, sa)]) in
let (Sess sb) = b.lens.get s in
let s = b.lens.put s (Sess [Recv (a.role, ch, sb)]) in
s
let (-%%->) a b ((al,bl),sl) ((ar,br),sr) =
let ch = Channel.create () in
let Sess sal, Sess sar = al.lens.get sl, ar.lens.get sr in
let sl, sr = al.lens.put sl (Sess [Close]), ar.lens.put sr (Sess [Close]) in
let Sess sbl, Sess sbr = bl.lens.get sl, br.lens.get sr in
let sl, sr = bl.lens.put sl (Sess [Close]), br.lens.put sr (Sess [Close]) in
let s = bl.merge sl sr in
let s = a.lens.put s (Sess [Select (b.role, ch, sal, sar)]) in
let s = b.lens.put s (Sess [Branch (a.role, ch, sbl, sbr)]) in
s
(* end
*
* module ThreeParty = struct
* open Local *)
let finish3 =
let (s1,s2,s3) as roles = [Close],[Close],[Close] in
Sess s1, Sess s2, Sess s3
type a = A
type b = B
type c = C
let merge3 (Sess xs,Sess ys,Sess zs) (Sess xs',Sess ys',Sess zs') = Sess (xs@xs'),Sess (ys@ys'),Sess (zs@zs')
let a = {role=A; lens={get=(fun (x,_,_) -> x); put=(fun (_,y,z) x->(x,y,z))}; merge=merge3}
let b = {role=B; lens={get=(fun (_,y,_) -> y); put=(fun (x,_,z) y->(x,y,z))}; merge=merge3}
let c = {role=C; lens={get=(fun (_,_,z) -> z); put=(fun (x,y,_) z->(x,y,z))}; merge=merge3}
(* end *)
(* open ThreeParty *)
let global_example () =
(* let open Global in *)
(a --> b) @@
(b --> c) @@
(a -%%-> b)
((a,b), b --> c @@
finish3)
((a,b), b --> a @@
b --> c @@
finish3)
(* open Local *)
let t1 sa =
let s = sa in
let s = send B 100 s in
if Random.bool () then
let s = select_left B s in
close s
else
let s = select_right B s in
let v,s = receive B s in
Printf.printf "A: received: %s\n" v;
close s
let t2 sb =
let s = sb in
let v,s = receive A s in
Printf.printf "B: received: %d\n" v;
let s = send C "Hello" s in
match branch A s with
| Left s ->
let s = send C "to C (1)" s in
close s
| Right s ->
let s = send A "to A" s in
let s = send C "to C (2)" s in
close s
let t3 sc =
let s = sc in
let v,s = receive B s in
Printf.printf "C: received: %s\n" v;
let w,s = receive B s in
Printf.printf "C: received: %s\n" w;
close s
let main () =
Random.self_init ();
let g = global_example () in
let sa, sb, sc = a.lens.get g, b.lens.get g, c.lens.get g in
(* let t1id = Thread.create (fun () -> t1 sa) () in
* let t2id = Thread.create (fun () -> t2 sb) () in
* t3 sc;
* Thread.join t1id;
* Thread.join t2id; *)
()
(* let () = main () *)
class Msg<V, CONT> {
}
class Send<R, LCONT> {
}
class Recv<R, LCONT> {
}
class Close { }
class RA { }
class RB { }
class RC { }
class PT3<A, B, C> {
a: A
b: B
c: C
a2bMsg<V>(): PT3<Send<RB, Msg<V, A>>, Recv<RA, Msg<V, B>>, C> {
// TODO
return null;
}
b2cMsg<V>(): PT3<Recv<RB, Msg<V, A>>, Send<RA, Msg<V, B>>, C> {
return null;
}
c2aMsg<V>(): PT3<Recv<RB, Msg<V, A>>, Send<RA, Msg<V, B>>, C> {
return null;
}
}
function a2bMsg<A,B,C,V>(cont: PT3<A, B, C>): PT3<Send<RB, Msg<V, A>>, Recv<RA, Msg<V, B>>, C>{
return null;
}
function main() {
var finish: PT3<Close, Close, Close> = new PT3();
// var prot = finish.a2bMsg<number>().a2bMsg<string>();
var prot = a2bMsg(a2bMsg(finish))
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.