externalval print :'a->unit="print"let id x = x
let f <<< g =fun x -> f (g x)let const x _= x
let x |> f = f x
let fst (x,_)= x
let snd (_, x)= x
let uncurry f (x, y)= f x y
let fork f g x =(f x, g x)class profunctor 'pbeginval dimap :forall'a'b'c'd.('b->'a)->('c->'d)->'p'a'c->'p'b'dendlet lmap g = dimap g id
let rmap x = dimap id x
class profunctor 'p=> strong 'pbeginval first :forall'a'b'c.'p'a'b->'p('a*'c)('b*'c)val second :forall'a'b'c.'p'a'b->'p('c*'a)('c*'b)endtypeeither'l'r=Leftof'l|Rightof'rleteither f g =function|Left x -> f x
|Right y -> g y
class profunctor 'p=> choice 'pbeginval left :forall'a'b'c.'p'a'b->'p(either'a'c)(either'b'c)val right :forall'a'b'c.'p'a'b->'p(either'c'a)(either'c'b)endclass monoid 'mbeginval(<>):'m->'m->'mval zero :'mendtype forget 'r'a'b=Forgetof'a->'rlet remember (Forget r)= r
instance profunctor (->)let dimap f g h = g <<< h <<< f
instance strong (->)let first f (x, y)=(f x, y)let second f (x, y)=(x, f y)instance choice (->)let left f =either(Left<<< f)Rightlet right f =eitherLeft(Right<<< f)instance profunctor (forget 'r)let dimap f _(Forget g)=Forget(g <<< f)instance monoid 'r=> choice (forget 'r)let left (Forget z)=Forget(either z (const zero))let right (Forget z)=Forget(either(const zero) z)instance strong (forget 'r)let first (Forget z)=Forget(z <<< fst)let second (Forget z)=Forget(z <<< snd)let lens get set =
dimap (fork get id)(uncurry set)<<< first
let view l = remember (l (Forget id))let over f = f
let set l b = over l (const b)let x ^. l = view l x
let l ^~ f = over l f
type pair 'a'b=Pairof'a*'blet fst' (Pair(x,_))= x
let snd' (Pair(_, x))= x
let first' x = lens fst' (fun x (Pair(_, y))->Pair(x, y)) x
let second' x = lens snd' (fun y (Pair(x,_))->Pair(x, y)) x
type proxy 'a=Proxytype optic 'p'a's<-'p'a'a->'p's'sclassAmc.row_cons 'r'k't'n=> has_lens 'r'k't'n|'k'n->'r'tbeginval rlens : strong 'p=> proxy 'k-> optic 'p't'nendinstanceAmc.known_string 'key*Amc.row_cons 'record'key'type'new=> has_lens 'record'key'type'newbeginlet rlens _=let view r =let(x,_)=Amc.restrict_row @'key r
x
let set x r =let(_, r')=Amc.restrict_row @'key r
Amc.extend_row @'key x r'
lens view set
endlet r
:forall'key->forall'record'type'new'p.Amc.known_string 'key* has_lens 'record'key'type'new* strong 'p=> optic 'p'type'new=fun x -> rlens @'record(Proxy: proxy 'key) x
let succ =(+1)