Updating: very very minorly

Updating: very very minorly

(*
** libatscc-common
*)

(* ****** ****** *)

(*
staload "./../basics.sats"
*)

(* ****** ****** *)
//
fun{}
stream_vt_make_nil
  {a:vt0p}(): stream_vt(a) = "mac#%"
fun{}
stream_vt_make_sing
  {a:t0p}(x0: a): stream_vt(a) = "mac#%"
//
(* ****** ****** *)
//
fun
stream_vt_free
  {a:vt0p}
  (stream_vt(a)):<!wrt> void = "mac#%"
//
(* ****** ****** *)
//
fun
stream_vt2t
  {a:t0p}
(
xs: stream_vt(INV(a))
) :<!wrt> stream(a) = "mac#%" // endfun
//
(* ****** ****** *)
//
fun
stream_vt_length
  {a:t0p}
  (stream_vt(INV(a))): intGte(0) = "mac#%"
//
(* ****** ****** *)
//
fun
stream_vt_takeLte
  {a:vt0p}
(
xs: stream_vt(INV(a)), n0: intGte(0)
) :<> stream_vt(a) = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun
stream2list_vt
  {a:vt0p}
  (stream_vt(INV(a))): List0_vt(a) = "mac#%"
fun
stream2list_vt_rev
  {a:vt0p}
  (stream_vt(INV(a))): List0_vt(a) = "mac#%"
//
(* ****** ****** *)
//
fun
stream_vt_append
  {a:vt0p}
(
  stream_vt(INV(a)), stream_vt(a)
) :<> stream_vt(a) = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun
stream_vt_concat
  {a:vt0p}
(
  xss: stream_vt(stream_vt(INV(a)))
) :<> stream_vt(a) = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun
stream_vt_map_cloref
  {a:vt0p}{b:vt0p}
(
  xs: stream_vt(INV(a)), fopr: (a) -<cloref1> b
) : stream_vt(b) = "mac#%" // end-of-function
fun
stream_vt_map_method
  {a:vt0p}{b:vt0p}
(
xs: stream_vt(INV(a)), TYPE(b)
) :
(
 (a) -<cloref1> b
) -<lincloptr1> stream_vt(b) = "mac#%" // endfun
//
(* ****** ****** *)
//
fun
stream_vt_filter_cloref
  {a:t0ype}
(
  xs: stream_vt(INV(a)), pred: (a) -<cloref1> bool
) : stream_vt(a) = "mac#%" // end-of-function
fun
stream_vt_filter_method
  {a:t0ype}
(
xs: stream_vt(INV(a))
) :
(
  (a) -<cloref1> bool
) -<lincloptr1> stream_vt(a) = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun
stream_vt_exists_cloref
  {a:t0ype}
(
stream_vt(INV(a)), pred: (a) -<cloref1> bool
) : bool = "mac#%" // end-of-function
fun
stream_vt_exists_method
  {a:t0ype}
(
xs: stream_vt(INV(a))
) : ((a) -<cloref1> bool) -<lincloptr1> bool = "mac#%"
//
(* ****** ****** *)
//
fun
stream_vt_forall_cloref
  {a:t0ype}
(
stream_vt(INV(a)), pred: (a) -<cloref1> bool
) : bool = "mac#%" // end-of-function
fun
stream_vt_forall_method
  {a:t0ype}
(
xs: stream_vt(INV(a))
) : ((a) -<cloref1> bool) -<lincloptr1> bool = "mac#%"
//
(* ****** ****** *)
//
fun
stream_vt_foreach_cloref
  {a:vt0ype}
(
xs: stream_vt(INV(a)), fwork: (a) -<cloref1> void
) : void = "mac#%" // end-of-function
fun
stream_vt_foreach_method
  {a:vt0ype}
(
xs: stream_vt(INV(a))
) :<> ((a) -<cloref1> void) -<lincloptr1> void = "mac#%"
//
(* ****** ****** *)
//
fun
stream_vt_iforeach_cloref
  {a:vt0ype}
(
xs: stream_vt(INV(a)), fwork: (Nat, a) -<cloref1> void
) : void = "mac#%" // end-of-function
fun
stream_vt_iforeach_method
  {a:vt0ype}
(
xs: stream_vt(INV(a))
) :<> ((Nat, a) -<cloref1> void) -<lincloptr1> void = "mac#%"
//
(* ****** ****** *)
//
fun
stream_vt_tabulate_cloref
  {a:t0p}
  (fopr: intGte(0) -<cloref1> a): stream_vt(a) = "mac#%"
//
(* ****** ****** *)
//
overload length with stream_vt_length of 100
overload append with stream_vt_append of 100
overload concat with stream_vt_concat of 100
//
overload .takeLte with stream_vt_takeLte of 100
//
overload .map with stream_vt_map_method of 100
overload .filter with stream_vt_filter_method of 100
overload .foreach with stream_vt_foreach_method of 100
overload .iforeach with stream_vt_iforeach_method of 1001
//
(* ****** ****** *)

(* end of [stream_vt.sats] *)

(*
** libatscc-common
*)

(* ****** ****** *)

(*
staload "./../basics.sats"
*)

(* ****** ****** *)
//
fun{}
stream_vt_make_nil
  {a:vt0p}(): stream_vt(a) = "mac#%"
fun{}
stream_vt_make_sing
  {a:t0p}(x0: a): stream_vt(a) = "mac#%"
//
(* ****** ****** *)
//
fun
stream_vt_free
  {a:vt0p}
  (stream_vt(a)):<!wrt> void = "mac#%"
//
(* ****** ****** *)
//
fun
stream_vt2t
  {a:t0p}
(
xs: stream_vt(INV(a))
) :<!wrt> stream(a) = "mac#%" // endfun
//
(* ****** ****** *)
//
fun
stream_vt_length
  {a:t0p}
  (stream_vt(INV(a))): intGte(0) = "mac#%"
//
(* ****** ****** *)
//
fun
stream_vt_takeLte
  {a:vt0p}
(
xs: stream_vt(INV(a)), n0: intGte(0)
) :<> stream_vt(a) = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun
stream2list_vt
  {a:vt0p}
  (stream_vt(INV(a))): List0_vt(a) = "mac#%"
fun
stream2list_vt_rev
  {a:vt0p}
  (stream_vt(INV(a))): List0_vt(a) = "mac#%"
//
(* ****** ****** *)
//
fun
stream_vt_append
  {a:vt0p}
(
  stream_vt(INV(a)), stream_vt(a)
) :<> stream_vt(a) = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun
stream_vt_concat
  {a:vt0p}
(
  xss: stream_vt(stream_vt(INV(a)))
) :<> stream_vt(a) = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun
stream_vt_map_cloref
  {a:vt0p}{b:vt0p}
(
  xs: stream_vt(INV(a)), fopr: (a) -<cloref1> b
) : stream_vt(b) = "mac#%" // end-of-function
fun
stream_vt_map_method
  {a:vt0p}{b:vt0p}
(
xs: stream_vt(INV(a)), TYPE(b)
) :
(
 (a) -<cloref1> b
) -<lincloptr1> stream_vt(b) = "mac#%" // endfun
//
(* ****** ****** *)
//
fun
stream_vt_filter_cloref
  {a:t0ype}
(
  xs: stream_vt(INV(a)), pred: (a) -<cloref1> bool
) : stream_vt(a) = "mac#%" // end-of-function
fun
stream_vt_filter_method
  {a:t0ype}
(
xs: stream_vt(INV(a))
) :
(
  (a) -<cloref1> bool
) -<lincloptr1> stream_vt(a) = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun
stream_vt_exists_cloref
  {a:t0ype}
(
xs: stream_vt(INV(a)), pred: (a) -<cloref1> bool
) : bool = "mac#%" // end-of-function
fun
stream_vt_exists_method
  {a:t0ype}
(
xs: stream_vt(INV(a))
) : ((a) -<cloref1> bool) -<lincloptr1> bool = "mac#%"
//
(* ****** ****** *)
//
fun
stream_vt_forall_cloref
  {a:t0ype}
(
xs: stream_vt(INV(a)), pred: (a) -<cloref1> bool
) : bool = "mac#%" // end-of-function
fun
stream_vt_forall_method
  {a:t0ype}
(
xs: stream_vt(INV(a))
) : ((a) -<cloref1> bool) -<lincloptr1> bool = "mac#%"
//
(* ****** ****** *)
//
fun
stream_vt_foreach_cloref
  {a:vt0ype}
(
xs: stream_vt(INV(a)), fwork: (a) -<cloref1> void
) : void = "mac#%" // end-of-function
fun
stream_vt_foreach_method
  {a:vt0ype}
(
xs: stream_vt(INV(a))
) :<> ((a) -<cloref1> void) -<lincloptr1> void = "mac#%"
//
(* ****** ****** *)
//
fun
stream_vt_iforeach_cloref
  {a:vt0ype}
(
xs: stream_vt(INV(a)), fwork: (Nat, a) -<cloref1> void
) : void = "mac#%" // end-of-function
fun
stream_vt_iforeach_method
  {a:vt0ype}
(
xs: stream_vt(INV(a))
) :<> ((Nat, a) -<cloref1> void) -<lincloptr1> void = "mac#%"
//
(* ****** ****** *)
//
fun
stream_vt_tabulate_cloref
  {a:t0p}
  (fopr: intGte(0) -<cloref1> a): stream_vt(a) = "mac#%"
//
(* ****** ****** *)
//
overload length with stream_vt_length of 100
overload .takeLte with stream_vt_takeLte of 100
//
overload .map with stream_vt_map_method of 100
overload .filter with stream_vt_filter_method of 100
overload .foreach with stream_vt_foreach_method of 100
overload .iforeach with stream_vt_iforeach_method of 1001
//
(* ****** ****** *)

(* end of [stream_vt.sats] *)


Updating: very minorly improving

Updating: very minorly improving

(*
** Channel pairs
*)

(* ****** ****** *)
//
staload
"./../SATS/basis.sats"
staload
"./../SATS/intset.sats"
//
staload "./basis_uchan.dats"
//
(* ****** ****** *)
//
absvtype
channel0_vtype(a:vt@ype, n:int)
//
stadef channel0 = channel0_vtype
//
extern
praxi
lemma_channel0_param
  {a:vt0p}{n:int}
  (chan0: !channel0(a, n)): [n >= 0] void
//
(* ****** ****** *)
//
extern
fun
{a:vt0p}
channel0_posneg
  {n:nat}
(
  cap: intGt(0)
, nrole: int(n), G: intset(n)
) :
(
  channel0(a, n)(*pos*), channel0(a, n)(*neg*)
) (* end of [channel0_posneg] *)
//
(* ****** ****** *)
//
extern
fun
{a:vt0p}
channel0_free
  {n:int}(chan0: channel0(a, n)): void
//
(* ****** ****** *)
//
extern
fun{a:vt0p}
channel0_send
  {n:int}
(
  !channel0(a, n)
, i: natLt(n), j: natLt(n), x: a
) : void // end-of-function
//
extern
fun{a:vt0p}
channel0_recv
  {n:int}
(
  !channel0(a, n)
, i: natLt(n), j: natLt(n), x: &a? >> a
) : void // end-of-function
extern
fun{a:vt0p}
channel0_recv_val
  {n:int}
(
  !channel0(a, n), i: natLt(n), j: natLt(n)
) : (a) // end of [channel0_recv_val]
//
(* ****** ****** *)
//
datavtype
channel0_
(
  a:vt@ype, n:int
) =
CHANNEL0 of
(
  int(n), intset(n), matrixptr(uchan(a), n, n)
) (* end of [channel0_] *)
//
(* ****** ****** *)
//
assume
channel0_vtype
  (a:vt0p, n:int) = channel0_(a, n)
//
(* ****** ****** *)

implement
{a}(*tmp*)
channel0_free
  (chan0) = let
//
val () =
lemma_channel0_param(chan0)
//
val
~CHANNEL0(n, G, chmat) = chan0
//
implement
(elt:vtype)
matrix_uninitize$clear<elt>
  (i, j, x) = let
//
val x = $UN.castvwtp0{ptr}(x)
//
in
//
if
isneqz(x)
then (
  uchan_unref($UN.castvwtp0{uchan(a)}(x))
) (* end of [if] *)
//
end // end of [matrix_uninitize$clear]
//
val n = i2sz(n)
//
val () = matrixptr_freelin(chmat, n, n)
//
in
  // nothing
end // end of [channel0_free]

(* ****** ****** *)

implement
{a}(*tmp*)
channel0_send
  (chan0, i, j, x0) =
{
//
val+CHANNEL0(n, G, chmat) = chan0
//
val p0 = ptrcast(chmat)
//
val uch =
  $UN.ptr0_get_at<uchan(a)>(p0, i*n+j)
//
val ((*void*)) = uchan_insert<a> (uch, x0)
//
val ((*returned*)) = $UN.cast2void(uch)
//
} (* end of [channel0_send] *)

(* ****** ****** *)

implement
{a}(*tmp*)
channel0_recv
  (chan0, i, j, x0) = let
//
val+CHANNEL0(n, G, chmat) = chan0
//
val p0 = ptrcast(chmat)
//
val p_ij =
  ptr_add<uchan(a)>(p0, i*n+j)
//
val (pf, fpf | p_ij) =
  $UN.ptr_vtake{uchan(a)}(p_ij)
//
val () = (x0 := uchan_remove<a> (!p_ij))
//
prval ((*returned*)) = fpf(pf)
//
in
  // nothing
end // end of [channel0_recv]

(* ****** ****** *)

implement
{a}(*tmp*)
channel0_recv_val
  (chan0, i, j) = x0 where
{
//
var x0: a // uninitized
//
val () = channel0_recv(chan0, i, j, x0)
//
} (* end of [channel0_recv_val] *)

(* ****** ****** *)

(* end of [basic_channel0.dats] *)

(*
** Channel pairs
*)

(* ****** ****** *)
//
staload
"./../SATS/basis.sats"
staload
"./../SATS/intset.sats"
//
staload "./basis_uchan.dats"
//
(* ****** ****** *)
//
absvtype
channel0_vtype(a:vt@ype, n:int)
//
stadef channel0 = channel0_vtype
//
extern
praxi
lemma_channel0_param
  {a:vt0p}{n:int}(!channel0(a, n)): [n >= 0] void
//
(* ****** ****** *)
//
extern
fun
{a:vt0p}
channel0_make_pair
  {n:nat}
(
  n: int(n), capacity: intGt(0)
) : (channel0(a, n), channel0(a, n))
//
(* ****** ****** *)
//
extern
fun
{a:vt0p}
channel0_free
  {n:int}(chan0: channel0(a, n)): void
//
(* ****** ****** *)
//
extern
fun{a:vt0p}
channel0_send
  {n:int}
(
  !channel0(a, n)
, i: natLt(n), j: natLt(n), x: a
) : void // end-of-function
//
extern
fun{a:vt0p}
channel0_recv
  {n:int}
(
  !channel0(a, n)
, i: natLt(n), j: natLt(n), x: &a? >> a
) : void // end-of-function
extern
fun{a:vt0p}
channel0_recv_val
  {n:int}
(
  !channel0(a, n), i: natLt(n), j: natLt(n)
) : (a) // end of [channel0_recv_val]
//
(* ****** ****** *)
//
datavtype
channel0_
(
  a:vt@ype, n:int
) =
CHANNEL0 of
(
  int(n), intset(n), matrixptr(uchan(a), n, n)
) (* end of [channel0_] *)
//
(* ****** ****** *)
//
assume
channel0_vtype
  (a:vt0p, n:int) = channel0_(a, n)
//
(* ****** ****** *)

implement
{a}(*tmp*)
channel0_free
  (chan0) = let
//
val () =
lemma_channel0_param(chan0)
//
val
~CHANNEL0(n, G, chmat) = chan0
//
implement
(elt:vtype)
matrix_uninitize$clear<elt>
  (i, j, x) = let
//
val x = $UN.castvwtp0{ptr}(x)
//
in
//
if
isneqz(x)
then (
  uchan_unref($UN.castvwtp0{uchan(a)}(x))
) (* end of [if] *)
//
end // end of [matrix_uninitize$clear]
//
val n = i2sz(n)
//
val () = matrixptr_freelin(chmat, n, n)
//
in
  // nothing
end // end of [channel0_free]

(* ****** ****** *)

implement
{a}(*tmp*)
channel0_send
  (chan0, i, j, x0) =
{
//
val+CHANNEL0(n, G, chmat) = chan0
//
val p0 = ptrcast(chmat)
//
val uch =
  $UN.ptr0_get_at<uchan(a)>(p0, i*n+j)
//
val ((*void*)) = uchan_insert<a> (uch, x0)
//
val ((*returned*)) = $UN.cast2void(uch)
//
} (* end of [channel0_send] *)

(* ****** ****** *)

implement
{a}(*tmp*)
channel0_recv
  (chan0, i, j, x0) = let
//
val+CHANNEL0(n, G, chmat) = chan0
//
val p0 = ptrcast(chmat)
//
val p_ij =
  ptr_add<uchan(a)>(p0, i*n+j)
//
val (pf, fpf | p_ij) =
  $UN.ptr_vtake{uchan(a)}(p_ij)
//
val () = (x0 := uchan_remove<a> (!p_ij))
//
prval ((*returned*)) = fpf(pf)
//
in
  // nothing
end // end of [channel0_recv]

(* ****** ****** *)

implement
{a}(*tmp*)
channel0_recv_val
  (chan0, i, j) = x0 where
{
//
var x0: a // uninitized
//
val () = channel0_recv(chan0, i, j, x0)
//
} (* end of [channel0_recv_val] *)

(* ****** ****** *)

(* end of [basic_channel0.dats] *)


Updating: very minorly improving

Updating: very minorly improving

(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTcom
// Start time: February, 2016
//
(* ****** ****** *)
//
// Following a Promela-example in
// (Spin Model Checker Primer Reference)
//
(* ****** ****** *)

(*
proctype
Agent(chan listen; chan talk)
{
    do
    :: talk!hold(listen)
    :: talk!deny(listen) -> break
    :: talk!grant(listen) ->
        wait:
        listen?return0; break
    od;
    server!return0(listen)
}
*)

(* ****** ****** *)

abstype channel

(* ****** ****** *)
//
extern
fun
channel_recv{a:type}(channel): a
extern
fun
channel_send{a:type}(channel, a): void
//
extern
fun
channel_create(cap: intGte(0)): channel
//
(* ****** ****** *)

extern
fun
channel_is_empty : channel -> bool
extern
fun
channel_isnot_empty : channel -> bool

(* ****** ****** *)
//
datatype
AgentReply =
| DENY of ()
| DENY of (channel)
| HOLD of (channel)
| GRANT of (channel)
//
datatype
ClientReply = RETURN0 of ()
//
datatype
ServerOpt =
  | RETURN0 of (channel)
  | REQUEST0 of (channel)
//
(* ****** ****** *)
//
val
theServer = channel_create(0)
//
(* ****** ****** *)
//
extern
fun
Agent
(
  agent: channel, client: channel
) : void // end of [Agent]
//
(* ****** ****** *)

extern val RAND: int

(* ****** ****** *)
//
implement
Agent(agent, client) = let
//
fun
loop
( agent: channel
, client: channel
) : void = (
//
case RAND of
| 0 => let
    val () =
    channel_send(client, HOLD(agent))
  in
    loop(agent, client)
  end // end of [_]
| 1 =>
    channel_send(client, DENY(agent))
| _ => let
    val () =
    channel_send(client, GRANT(agent))
    val-RETURN0() =
      channel_recv{ClientReply}(agent)
    // end of [val]
  in
    // break
  end // end of [_]
//
) (* end of [loop] *)
//
val () = loop(agent, client)
//
in
  channel_send(theServer, agent)
end // end of [Agent]
//
(* ****** ****** *)

(*
#define M 2
active [M] proctype Client()
{
    chan me = [0] of { mtype, chan };
    chan agent;
end:
    do
    :: timeout ->
        server!request(me);
        do
        :: me?hold(agent)
        :: me?deny(agent) -> break
        :: me?grant(agent) -> agent!return0; break
        od
    od
}
*)

(* ****** ****** *)
//
extern
fun Client(): void
//
(* ****** ****** *)
//
implement
Client() = let
//
fun
loop
(
  client: channel
) : void =
(
//
case+ RAND of
| _ => let
    val () =
    channel_send(theServer, REQUEST0(client))
  in
    loop2(client)
  end // end of [loop]
//
) (* end of [loop] *)
//
and
loop2
(
  client: channel
) : void = let
  val opt = channel_recv{AgentReply}(client)
in
//
case+ opt of
| DENY() => ()
| DENY(agent) => ()
| HOLD(agent) => loop2(client)
| GRANT(agent) => channel_send(agent, RETURN0())
//
end // end of [loop2]
//
in
  loop(channel_create(0))
end // end of [Client]

(* ****** ****** *)

(*
active
proctype Server()
{
    chan agents[N] = [0] of { mtype };
    chan pool = [N] of { chan };
    chan client, agent;
    byte i;
    do
    :: i < N -> pool!agents[i]; i++
    :: else -> break
    od;
    end:
    do
    :: server?request(client) ->
        if
        :: empty(pool) ->
            client!deny(0)
        :: nempty(pool) ->
            pool?agent;
            run Agent(agent,client)
        fi
    :: server?return0(agent) ->
        pool!agent
    od
}
*)

(* ****** ****** *)
//
extern
fun Server((*void*)): void
//
implement
Server() = let
//
fun
loop
(
  pool: channel
) : void = let
//
val
opt =
channel_recv{ServerOpt}(theServer)
//
in
//
case+ opt of
| RETURN0(agent) => let
    val () =
    channel_send{channel}(pool, agent)
  in
    loop(pool)
  end // end of [RETURN0]
| REQUEST0(client) =>
  if channel_isnot_empty(pool)
    then let
      val agent =
        channel_recv{channel}(pool)
      // end of [val]
      val () = Agent(agent, client)
    in
      loop(pool)
    end // end of [then]
    else let
      val () =
      channel_send(client, DENY((*void*)))
    in
      loop(pool)
    end // end of [else]
//
end // end of [loop]
//
val
pool = channel_create(5)
//
in
  loop(pool)
end // end of [Server]
//
(* ****** ****** *)

(* end of [ClientServer-1.dats] *)

(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTcom
// Start time: February, 2016
//
(* ****** ****** *)

(*
proctype
Agent(chan listen; chan talk)
{
    do
    :: talk!hold(listen)
    :: talk!deny(listen) -> break
    :: talk!grant(listen) ->
        wait:
        listen?return0; break
    od;
    server!return0(listen)
}
*)

(* ****** ****** *)

abstype channel

(* ****** ****** *)
//
extern
fun
channel_recv{a:type}(channel): a
extern
fun
channel_send{a:type}(channel, a): void
//
extern
fun
channel_create(cap: intGte(0)): channel
//
(* ****** ****** *)
//
datatype
AgentReply =
| DENY of (channel)
| HOLD of (channel)
| GRANT of (channel)
//
datatype ClientReply = RETURN0 of ()
datatype ClientRequest = REQUEST0 of (channel)
//
(* ****** ****** *)
//
val
theServer = channel_create(0)
//
(* ****** ****** *)
//
extern
fun
Agent
(
  agent: channel, client: channel
) : void // end of [Agent]
//
(* ****** ****** *)

extern val RAND: int

(* ****** ****** *)
//
implement
Agent(agent, client) = (
//
case RAND of
| 0 => let
    val () =
    channel_send(client, HOLD(agent))
  in
    Agent(agent, client)
  end // end of [_]
| 1 =>
    channel_send(client, DENY(agent))
| _ => let
    val () =
    channel_send(client, GRANT(agent))
    val-RETURN0() =
      channel_recv{ClientReply}(agent)
    // end of [val]
  in
    // break
  end // end of [_]
//
) (* end of [Agent] *)
//
(* ****** ****** *)

(*
#define M 2
active [M] proctype Client()
{
    chan me = [0] of { mtype, chan };
    chan agent;
end:
    do
    :: timeout ->
        server!request(me);
        do
        :: me?hold(agent)
        :: me?deny(agent) -> break
        :: me?grant(agent) -> agent!return0; break
        od
    od
}
*)

(* ****** ****** *)
//
extern
fun Client(): void
//
(* ****** ****** *)
//
implement
Client() = let
//
fun
loop
(
  client: channel
) : void =
(
//
case+ RAND of
| _ => let
    val () =
    channel_send(theServer, REQUEST0(client))
  in
    loop2(client)
  end // end of [loop]
//
) (* end of [loop] *)
//
and
loop2
(
  client: channel
) : void = let
  val opt = channel_recv{AgentReply}(client)
in
//
case+ opt of
| DENY(agent) => ()
| HOLD(agent) => loop2(client)
| GRANT(agent) => channel_send(agent, RETURN0())
//
end // end of [loop2]
//
in
  loop(channel_create(0))
end // end of [Client]

(* ****** ****** *)

(* end of [ClientServer-1.dats] *)


Updating: very minorly improving

Updating: very minorly improving

(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTcom
// Start time: February, 2016
//
(* ****** ****** *)
//
// Following a Promela-example in
// (Spin Model Checker Primer Reference)
//
(* ****** ****** *)

(*
proctype
Agent(chan listen; chan talk)
{
    do
    :: talk!hold(listen)
    :: talk!deny(listen) -> break
    :: talk!grant(listen) ->
        wait:
        listen?return0; break
    od;
    server!return0(listen)
}
*)

(* ****** ****** *)

abstype chnil
abstype chcons(x:vt@ype, xs:type)

(* ****** ****** *)

stadef :: = chcons

(* ****** ****** *)

abstype chanref(a:vtype)

(* ****** ****** *)
//
absvtype channel0
//
absvtype chanpos1(ss:vtype)
absvtype channeg1(ss:vtype)
//
(* ****** ****** *)
//
extern
fun
channel0_create
  (cap: intGte(0)): channel0
//
extern
fun channel0_destroy(channel0): void
//
(* ****** ****** *)
//
extern
fun
channel0_split{ss:vtype}
  (chan: !channel0 >> chanpos1(ss)): channeg1(ss)
//
(* ****** ****** *)
//
extern
prfun
channeg1_nil_close (channeg1(chnil)): void
extern
prfun
chanpos1_nil_close (!chanpos1(chnil) >> channel0): void
//
(* ****** ****** *)

extern
fun
chanpos1_recv
{x:vt@ype}{xs:type}
(
  chan: !chanpos1(x::xs) >> chanpos1(xs)
) : x // end of [chanpos1_recv]

(* ****** ****** *)

extern
fun
channeg1_send
{x:vt@ype}{xs:type}
(
  chan: !channeg1(x::xs) >> channeg1(xs), x: (x)
) : void // end of [channeg1_send]

(* ****** ****** *)

datavtype
ss_client =
  | DENY of (chnil)
  | DENY of (channeg1(chnil), chnil)
  | HOLD of (channeg1(chnil), ss_client)
  | GRANT of (channeg1(ss_grant), chnil)
//
and ss_grant = RETURN1 of (chnil)
//
(* ****** ****** *)
//
datavtype
ClientOpt(ss:vtype) =
  | DENY(chnil) of ()
  | DENY(chnil) of channeg1(chnil)
  | HOLD(ss_client) of channeg1(chnil)
  | GRANT(chnil) of (channeg1(ss_grant))
//
datatype
AgentGrantOpt(ss:vtype) = RETURN1(chnil) of ()
//
(* ****** ****** *)
//
extern
fun
chanref_recv
  {a:vtype}(chan: chanref(a)): (a)
extern
fun
chanref_send
  {a:vtype}(chan: chanref(a), x: (a)): void
//
(* ****** ****** *)
//
extern
fun
channeg1_client{ss:vtype}
  (chan: !channeg1(ss_client) >> channeg1(ss), x: ClientOpt(ss)): void
extern
fun
chanpos1_client
  (chan: !chanpos1(ss_client) >> chanpos1(ss)): #[ss:vtype] ClientOpt(ss)
//
(* ****** ****** *)
//
extern
fun
channeg1_grant{ss:vtype}
  (chan: !channeg1(ss_grant) >> channeg1(ss), x: AgentGrantOpt(ss)): void
extern
fun
chanpos1_grant
  (chan: !chanpos1(ss_grant) >> chanpos1(ss)): #[ss:vtype] AgentGrantOpt(ss)
//
(* ****** ****** *)

extern val RANDOM : int

(* ****** ****** *)
//
datavtype
ServerOpt =
  | RETURN0 of (channel0)
  | REQUEST0 of (channeg1(ss_client))
//
(* ****** ****** *)

extern
val
theServer : chanref(ServerOpt)

(* ****** ****** *)
//
extern
fun Server((*void*)): void
extern
fun Client((*void*)): void
//
extern
fun
Agent
(
  agent: channel0
, client: channeg1(ss_client)
) : void // end of [Agent]
//
(* ****** ****** *)
//
extern
fun
chanref_create
  {a:vtype}
  (cap: intGte(0)): chanref(a)
//
extern
fun
chanref_is_empty
  : {a:vtype} chanref(a) -> bool
extern
fun
chanref_isnot_empty
  : {a:vtype} chanref(a) -> bool
//
(* ****** ****** *)

implement
Server() = let
//
fun
loop
(
  pool: chanref(channel0)
) : void = let
//
val
opt = chanref_recv(theServer)
//
in
//
case+ opt of
| ~RETURN0(agent) => let
    val () =
    chanref_send(pool, agent)
  in
    loop(pool)
  end // end of [RETURN0]
| ~REQUEST0(client) =>
  if chanref_isnot_empty(pool)
    then let
      val agent =
        chanref_recv(pool)
      // end of [val]
      val () = Agent(agent, client)
    in
      loop(pool)
    end // end of [then]
    else let
      val () =
      channeg1_client(client, DENY())
      val () = channeg1_nil_close(client)
    in
      loop(pool)
    end // end of [else]
//
end // end of [loop]
//
val
pool = chanref_create(5)
//
in
  loop(pool)
end // end of [Server]
//
(* ****** ****** *)

implement
Agent(agent, client) = let
//
fun
loop
( agent: !channel0
, client: channeg1(ss_client)
) : void = (
//
case
RANDOM of
| 0 => let
    val
    agent2 =
    channel0_split{chnil}(agent)
    val () =
    channeg1_client(client, HOLD(agent2))
    val ((*void*)) = chanpos1_nil_close(agent)
  in
    loop(agent, client)
  end // end of [_]
| 1 => let
    val
    agent2 =
    channel0_split{chnil}(agent)
    val () =
    channeg1_client(client, DENY(agent2))
    val ((*void*)) = chanpos1_nil_close(agent)
    val ((*void*)) = channeg1_nil_close(client)
  in
    // break
  end // end of [1]
| _ => let
    val
    agent2 =
    channel0_split{ss_grant}(agent)
    val () =
    channeg1_client(client, GRANT(agent2))
    val+RETURN1() = chanpos1_grant(agent)
    val ((*void*)) = chanpos1_nil_close(agent)
    val ((*void*)) = channeg1_nil_close(client)
  in
    // break
  end // end of [_]
//
) (* end of [loop] *)
//
val () = loop(agent, client)
//
in
  chanref_send(theServer, RETURN0(agent))
end // end of [Agent]
//
(* ****** ****** *)
//
implement
Client() = let
//
fun
loop
(
  client: channel0
) : void =
(
//
case+
RANDOM
of // case
| _ => let
    val
    client2 =
    channel0_split{ss_client}(client)
    val () =
    chanref_send(theServer, REQUEST0(client2))
  in
    loop2(client)
  end // end of [loop]
//
) (* end of [loop] *)
//
and
loop2
(
  client: chanpos1(ss_client)
) : void = let
//
val opt = chanpos1_client(client)
//
in
//
case+ opt of
| ~DENY() =>
  {
    val () =
    chanpos1_nil_close(client)
    val () = channel0_destroy(client)
  }
| ~DENY(agent) =>
  {
    val () =
    channeg1_nil_close(agent)
    val () =
    chanpos1_nil_close(client)
    val () = channel0_destroy(client)
  }
| ~HOLD(agent) =>
  loop2(client) where
  {
    val () = channeg1_nil_close(agent)
  }
//
| ~GRANT(agent) =>
  {
    val () =
    channeg1_grant(agent, RETURN1())
    val () = channeg1_nil_close(agent)
    val () = chanpos1_nil_close(client)
    val () = channel0_destroy(client)
  }
//
end // end of [loop2]
//
in
  loop(channel0_create(0))
end // end of [Client]

(* ****** ****** *)

(* end of [ClientServer-2.dats] *)

(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTcom
// Start time: February, 2016
//
(* ****** ****** *)
//
// Following a Promela-example in
// (Spin Model Checker Primer Reference)
//
(* ****** ****** *)

(*
proctype
Agent(chan listen; chan talk)
{
    do
    :: talk!hold(listen)
    :: talk!deny(listen) -> break
    :: talk!grant(listen) ->
        wait:
        listen?return0; break
    od;
    server!return0(listen)
}
*)

(* ****** ****** *)

abstype chnil
abstype chcons(x:vt@ype, xs:type)

(* ****** ****** *)

stadef :: = chcons

(* ****** ****** *)

abstype chanref(a:vtype)

(* ****** ****** *)
//
absvtype channel0
//
absvtype chanpos1(ss:vtype)
absvtype channeg1(ss:vtype)
//
(* ****** ****** *)
//
extern
fun
channel0_split{ss:vtype}
  (chan: !channel0 >> chanpos1(ss)): channeg1(ss)
//
(* ****** ****** *)
//
extern
fun
channeg1_nil_close (channeg1(chnil)): void
extern
fun
chanpos1_nil_close (!chanpos1(chnil) >> channel0): void
//
(* ****** ****** *)

extern
fun
chanpos1_recv
{x:vt@ype}{xs:type}
(
  chan: !chanpos1(x::xs) >> chanpos1(xs)
) : x // end of [chanpos1_recv]

(* ****** ****** *)

extern
fun
channeg1_send
{x:vt@ype}{xs:type}
(
  chan: !channeg1(x::xs) >> channeg1(xs), x: (x)
) : void // end of [channeg1_send]

(* ****** ****** *)

datavtype
ss_client =
  | DENY of (chnil)
  | DENY of (channeg1(chnil), chnil)
  | HOLD of (channeg1(chnil), ss_client)
  | GRANT of (channeg1(ss_grant), chnil)
//
and ss_grant = RETURN1 of (chnil)
//
(* ****** ****** *)
//
datavtype
ClientOpt(ss:vtype) =
  | DENY(chnil) of ()
  | DENY(chnil) of channeg1(chnil)
  | HOLD(ss_client) of channeg1(chnil)
  | GRANT(chnil) of (channeg1(ss_grant))
//
datatype
AgentGrantOpt(ss:vtype) = RETURN1(chnil) of ()
//
(* ****** ****** *)
//
extern
fun
chanref_recv
  {a:vtype}(chan: chanref(a)): (a)
extern
fun
chanref_send
  {a:vtype}(chan: chanref(a), x: (a)): void
//
(* ****** ****** *)
//
extern
fun
channeg1_client{ss:vtype}
  (chan: !channeg1(ss_client) >> channeg1(ss), x: ClientOpt(ss)): void
extern
fun
chanpos1_client
  (chan: !chanpos1(ss_client) >> chanpos1(ss)): #[ss:vtype] ClientOpt(ss)
//
(* ****** ****** *)
//
extern
fun
channeg1_grant{ss:vtype}
  (chan: !channeg1(ss_grant) >> channeg1(ss), x: AgentGrantOpt(ss)): void
extern
fun
chanpos1_grant
  (chan: !chanpos1(ss_grant) >> chanpos1(ss)): #[ss:vtype] AgentGrantOpt(ss)
//
(* ****** ****** *)

extern val RANDOM : int

(* ****** ****** *)
//
datavtype
ServerOpt =
  | RETURN0 of (channel0)
  | REQUEST of (channeg1(ss_client))
//
(* ****** ****** *)

extern val theServer : chanref(ServerOpt)

(* ****** ****** *)
//
extern
fun
Agent
(
  agent: channel0
, client: channeg1(ss_client)
) : void // end of [Agent]
//
(* ****** ****** *)

implement
Agent(agent, client) = let
//
fun
loop
( agent: !channel0
, client: channeg1(ss_client)
) : void = (
//
case
RANDOM of
| 0 => let
    val
    agent2 =
    channel0_split{chnil}(agent)
    val () =
    channeg1_client(client, HOLD(agent2))
    val ((*void*)) = chanpos1_nil_close(agent)
  in
    loop(agent, client)
  end // end of [_]
| 1 => let
    val
    agent2 =
    channel0_split{chnil}(agent)
    val () =
    channeg1_client(client, DENY(agent2))
    val ((*void*)) = chanpos1_nil_close(agent)
    val ((*void*)) = channeg1_nil_close(client)
  in
    // break
  end // end of [1]
| _ => let
    val
    agent2 =
    channel0_split{ss_grant}(agent)
    val () =
    channeg1_client(client, GRANT(agent2))
    val+RETURN1() = chanpos1_grant(agent)
    val ((*void*)) = chanpos1_nil_close(agent)
    val ((*void*)) = channeg1_nil_close(client)
  in
    // break
  end // end of [_]
//
) (* end of [loop] *)
//
val () = loop(agent, client)
//
in
  chanref_send(theServer, RETURN0(agent))
end // end of [Agent]
//
(* ****** ****** *)

(* end of [ClientServer-2.dats] *)


Updating: fixing a typo

Updating: fixing a typo

//
// Some code for testing
// the API in ATS for libev
//
(* ****** ****** *)
//
#define
PATSCONTRIB "\
https://raw.githubusercontent.com/\
githwxi/ATS-Postiats-contrib/master/contrib"
//
(*
//
// HX-2014-05-14: this is a backup:
//
#define
PATSCONTRIB "http://www.ats-lang.org/LIBRARY/contrib"
*)
//
(* ****** ****** *)
//
require "{$PATSCONTRIB}/libats-/hwxi/libev/SATS/ev.sats"
require "{$PATSCONTRIB}/libats-/hwxi/libev/DATS/ev.dats"
require "{$PATSCONTRIB}/libats-/hwxi/libev/CATS/ev.cats"
//
(* ****** ****** *)

staload "{$PATSCONTRIB}/libats-/hwxi/libev/SATS/ev.sats"

(* ****** ****** *)

val () =
{
//
val major = ev_version_major ()
val minor = ev_version_minor ()
//
val () = println! ("ev_version_major() = ", major)
val () = println! ("ev_version_minor() = ", minor)
//
} (* end of [val] *)

(* ****** ****** *)

implement main0 () = ()

(* ****** ****** *)

(* end of [test00-pkgreloc.dats] *)

//
// Some code for testing
// the API in ATS for libev
//
(* ****** ****** *)
//
#define
PATSCONTRIB "\
https://raw.githubusercontent.com/\
githwxi/ATS-Postiats-contrib/master/contrib"
//
(*
//
// HX-2014-05-14: this is a backup:
//
#define
PATSCONTRIB "http://www.ats-lang.org/LIBRARY/contrib"
*)
//
(* ****** ****** *)
//
require "{$PATSCONTRIB}/libats-/hwxi/libev/SATS/ev.sats"
require "{$PATSCONTRIB}/libats-/hwxi/libev/DATS/ev.dats"
require "{$PATSCONTRIB}/libats-/hwxi/libev/CATS/ev.cats"
//
(* ****** ****** *)

staload "{$PATSCONTRIB}/libats-/hwxi/libev/SATS/ev.sats"

(* ****** ****** *)

val () =
{
//
val major = ev_version_major ()
val minor = ev_version_minor ()
//
val () = println! ("ev_version_major() = ", major)
val () = println! ("ev_version_minor() = ", minor)
//
} (* end of [val] *)

(* ****** ****** *)

implement main0 () = ()

(* ****** ****** *)

(* end of [test00.dats] *)


Updating: adding aruduino/LCDemoMatrix

Updating: adding aruduino/LCDemoMatrix

(*
#
# For testing LedControl
#
*)
(* ****** ****** *)

#define ATS_DYNLOADFLAG 0

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
#include
"{$ARDUINO}/staloadall.hats"
//
(* ****** ****** *)

staload "./../LedControl.sats"

(* ****** ****** *)

%{^
LedControl theLC;
%} // end of [%{^]

(* ****** ****** *)
//
extern
fun
setup (): void = "mac#"
//
implement
setup () =
{
//
extvar
"theLC" =
LedControl(12,11,10,1)
//
val lc =
$extval
  (LedControl_ptr, "theLC")
//
val () = lc.shutdown(0, false)
val () = lc.setIntensity(0, 8)
val () = lc.clearDisplay(  0  )
}
//
(* ****** ****** *)
//
macdef DELAY_TIME = 100UL
//
macdef
B00000000 = $extval(byte, "0")
macdef
B10100000 = $extval(byte, "B10100000")
//
(* ****** ****** *)

(*
void rows() {
  for(int row=0;row<8;row++) {
    delay(delaytime);
    lc.setRow(0,row,B10100000);
    delay(delaytime);
    lc.setRow(0,row,(byte)0);
    for(int i=0;i<row;i++) {
      delay(delaytime);
      lc.setRow(0,row,B10100000);
      delay(delaytime);
      lc.setRow(0,row,(byte)0);
    }
  }
}
*)
extern
fun
loop_rows
(
  LedControl_ptr
) : void = "mac#"
implement
loop_rows(lc) = let
//
fun
doWork(row: int): void =
{
//
val () = delay(DELAY_TIME)
val () = lc.setRow(0, row, B10100000)
val () = delay(DELAY_TIME)
val () = lc.setRow(0, row, B00000000)
//
} (* end of [doWork] *)
//
fun
loop1
(
  row: natLte(8)
) : void =
(
if
row < 8
then (doWork(row); loop2(row, 0); loop1(row+1))
else ()
)
and
loop2
(
  row: int, i: int
) : void =
(
  if i < row then (doWork(row); loop2(row, i+1)) else ()
)
//
in
  loop1 (0)
end // end of [loop_rows]

(* ****** ****** *)

(*
void rows() {
  for(int row=0;row<8;row++) {
    delay(delaytime);
    lc.setRow(0,row,B10100000);
    delay(delaytime);
    lc.setRow(0,row,(byte)0);
    for(int i=0;i<row;i++) {
      delay(delaytime);
      lc.setRow(0,row,B10100000);
      delay(delaytime);
      lc.setRow(0,row,(byte)0);
    }
  }
}
*)
extern
fun
loop_cols
(
  LedControl_ptr
) : void = "mac#"
implement
loop_cols(lc) = let
//
fun
doWork(col: int): void =
{
//
val () = delay(DELAY_TIME)
val () = lc.setColumn(0, col, B10100000)
val () = delay(DELAY_TIME)
val () = lc.setColumn(0, col, B00000000)
//
} (* end of [doWork] *)
//
fun
loop1
(
  col: natLte(8)
) : void =
(
if
col < 8
then (doWork(col); loop2(col, 0); loop1(col+1))
else ()
)
and
loop2
(
  col: int, i: int
) : void =
(
  if i < col
    then (doWork(col); loop2(col, i+1)) else ()
  // end of [if]
)
//
in
  loop1 (0)
end // end of [loop_cols]

(* ****** ****** *)
//
(*
void single() {
  for(int row=0;row<8;row++) {
    for(int col=0;col<8;col++) {
      delay(delaytime);
      lc.setLed(0,row,col,true);
      delay(delaytime);
      for(int i=0;i<col;i++) {
        lc.setLed(0,row,col,false);
        delay(delaytime);
        lc.setLed(0,row,col,true);
        delay(delaytime);
      }
    }
  }
}
*)
extern
fun
loop_single
(
  LedControl_ptr
) : void = "mac#"
implement
loop_single(lc) = let
//
fun
doWork
(
  row: int, col: int
) : void =
{
val () = delay(DELAY_TIME)
val () = lc.setLed(0,row,col,true)
val () = delay(DELAY_TIME)
} (* end of [doWork] *)
//
fun
loop_doWork
(
  row: int, col: int, i: int
) : void = (
//
if
i < col
then (
  lc.setLed
  (
    0, row, col, false
  ) ; doWork(row, col) ;
  loop_doWork(row, col, i+1)
) (* end of [then] *)
//
) (* end of [loop] *)
//
implement(env)
intrange2_foreach$fwork<env>
  (row, col, env) =
(
  doWork(row, col); loop_doWork(row, col, 0)
)
//
in
  intrange2_foreach(0, 8, 0, 8)
end // end of [loop_single]
//
(* ****** ****** *)
//
extern
fun
loop(): void = "mac#"
implement
loop() =
{
  val lc = $extval(LedControl_ptr, "theLC")
  val () = $extfcall(void, "writeArduinoOnMatrix", lc)
  val () = loop_rows(lc)
  val () = loop_cols(lc)
  val () = loop_single(lc)
} (* end of [loop] *)
//
(* ****** ****** *)

(* end of [LCDemoMatrix.dats] *)

(*
#
# For testing LedControl
#
*)
(* ****** ****** *)

#define ATS_DYNLOADFLAG 0

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
#include
"{$ARDUINO}/staloadall.hats"
//
(* ****** ****** *)

staload "./../LedControl.sats"

(* ****** ****** *)

%{^
LedControl theLC;
%} // end of [%{^]

(* ****** ****** *)
//
extern
fun
setup (): void = "mac#"
//
implement
setup () =
{
//
extvar
"theLC" =
LedControl(12,11,10,1)
//
val lc =
$extval
  (LedControl_ptr, "theLC")
//
val () = lc.shutdown(0, false)
val () = lc.setIntensity(0, 8)
val () = lc.clearDisplay(  0  )
}
//
(* ****** ****** *)
//
macdef DELAY_TIME = 100UL
//
macdef
B00000000 = $extval(byte, "0")
macdef
B10100000 = $extval(byte, "B10100000")
//
(* ****** ****** *)

(*
void rows() {
  for(int row=0;row<8;row++) {
    delay(delaytime);
    lc.setRow(0,row,B10100000);
    delay(delaytime);
    lc.setRow(0,row,(byte)0);
    for(int i=0;i<row;i++) {
      delay(delaytime);
      lc.setRow(0,row,B10100000);
      delay(delaytime);
      lc.setRow(0,row,(byte)0);
    }
  }
}
*)
extern
fun
loop_rows
(
  LedControl_ptr
) : void = "mac#"
implement
loop_rows(lc) = let
//
fun
doWork(row: int): void =
{
//
val () = delay(DELAY_TIME)
val () = lc.setRow(0, row, B10100000)
val () = delay(DELAY_TIME)
val () = lc.setRow(0, row, B00000000)
//
} (* end of [doWork] *)
//
fun
loop1
(
  row: natLte(8)
) : void =
(
if
row < 8
then (doWork(row); loop2(row, 0); loop1(row+1))
else ()
)
and
loop2
(
  row: int, i: int
) : void =
(
  if i < row then (doWork(row); loop2(row, i+1)) else ()
)
//
in
  loop1 (0)
end // end of [loop_rows]

(* ****** ****** *)

(*
void rows() {
  for(int row=0;row<8;row++) {
    delay(delaytime);
    lc.setRow(0,row,B10100000);
    delay(delaytime);
    lc.setRow(0,row,(byte)0);
    for(int i=0;i<row;i++) {
      delay(delaytime);
      lc.setRow(0,row,B10100000);
      delay(delaytime);
      lc.setRow(0,row,(byte)0);
    }
  }
}
*)
extern
fun
loop_cols
(
  LedControl_ptr
) : void = "mac#"
implement
loop_cols(lc) = let
//
fun
doWork(col: int): void =
{
//
val () = delay(DELAY_TIME)
val () = lc.setColumn(0, col, B10100000)
val () = delay(DELAY_TIME)
val () = lc.setColumn(0, col, B00000000)
//
} (* end of [doWork] *)
//
fun
loop1
(
  col: natLte(8)
) : void =
(
if
col < 8
then (doWork(col); loop2(col, 0); loop1(col+1))
else ()
)
and
loop2
(
  col: int, i: int
) : void =
(
  if i < col
    then (doWork(col); loop2(col, i+1)) else ()
  // end of [if]
)
//
in
  loop1 (0)
end // end of [loop_cols]

(* ****** ****** *)
//
extern
fun
loop_single(LedControl_ptr): void = "mac#"
//
(* ****** ****** *)
//
extern
fun
loop(): void = "mac#"
implement
loop() =
{
  val lc = $extval(LedControl_ptr, "theLC")
  val () = $extfcall(void, "writeArduinoOnMatrix", lc)
  val () = loop_rows(lc)
  val () = loop_cols(lc)
  val () = loop_single(lc)
} (* end of [loop] *)
//
(* ****** ****** *)

(* end of [LCDemoMatrix.dats] *)


Updating: improving JSclock

Updating: improving JSclock

(*
//
An example of atscc2js: Wall Clock
//
Author: Hongwei Xi
Authoremail: hwxi AT cs DOT bu DOT edu
Start Time: September, 2014
//
This example is essentially translated from
the JS code at the following site:
//
http://www.neilwallis.com/projects/html5/clock/
//
*)

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)

#define ATS_DYNLOADFLAG 0

(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
#include
"{$LIBATSCC2JS}/staloadall.hats"
//
(* ****** ****** *)
//
staload
"{$LIBATSCC2JS}/SATS/HTML/canvas-2d/canvas2d.sats"
//
(* ****** ****** *)

macdef PI = JSmath_PI
macdef sin = JSmath_sin and cos = JSmath_cos

(* ****** ****** *)

fun
draw_mark
(
  ctx: canvas2d, i: int
) : void = {
//
val a = PI/30*i
val sa = sin(a)
val ca = cos(a)
val sx = 110 * sa
val sy = 110 * ca
val ex = 120 * sa
val ey = 120 * ca
//
val () = ctx.lineWidth(2)
//
val () = ctx.beginPath()
val () = ctx.moveTo(sx, sy)
val () = ctx.lineTo(ex, ey)
val () = ctx.closePath()
//
val () = ctx.stroke()
//
} (* end of [draw_mark] *)

(* ****** ****** *)

fun
draw_mark2
(
  ctx: canvas2d, i: int
) : void = {
//
val a = PI/30*i
val sa = sin(a)
val ca = cos(a)
val sx =  95 * sa
val sy = ~95 * ca
val ex =  120 * sa
val ey = ~120 * ca
val nx =  80 * sa
val ny = ~80 * ca
//
val () = ctx.fillText(toString(i/5), nx, ny)
//
val () = ctx.lineWidth(8)
//
val () = ctx.beginPath()
val () = ctx.moveTo(sx, sy)
val () = ctx.lineTo(ex, ey)
val () = ctx.closePath()
//
val () = ctx.stroke()
//
} (* end of [draw_mark2] *)

(* ****** ****** *)
//
extern
fun
draw_clock
(
  ctx: canvas2d
, nhr: double, nmin: double, nsec: double
) : void = "mac#" // end-of-fun
//
implement
draw_clock
(
  ctx, nhr, nmin, nsec
) = () where {
//
val () = ctx.clearRect(0.0, 0.0, 300.0, 300.0)
//
// Define gradients for 3D-shadow effect
//
val g1 = ctx.createLinearGradient(0.0, 0.0, 300.0, 300.0)
val () = g1.addColorStop(0.0, "#D83040")
val () = g1.addColorStop(1.0, "#801020")
//
val g2 = ctx.createLinearGradient(0.0, 0.0, 300.0, 300.0)
val () = g2.addColorStop(0.0, "#801020")
val () = g2.addColorStop(1.0, "#D83040")
//
val () = ctx.font("bold 20px arial")
val () = ctx.textAlign("center")
val () = ctx.textBaseline("middle")
val () = ctx.lineWidth(1)
//
val () = ctx.strokeStyle_gradient(g1)
val () = ctx.lineWidth(10)
//
val pf = ctx.save()
val () = ctx.beginPath()
val () = ctx.arc(150.0, 150.0, 138.0, 0.0, 2*PI, true)
val () = ctx.closePath()
val () = ctx.shadowBlur(6)
val () = ctx.shadowOffsetX(4)
val () = ctx.shadowOffsetY(4)
val () = ctx.shadowColor("rgba(0,0,0,0.6)")
val () = ctx.stroke()
val () = ctx.restore(pf.0 | (*none*))
//
val () = ctx.strokeStyle_gradient(g2)
val () = ctx.lineWidth(10)
//
val pf = ctx.save()
val () = ctx.beginPath()
val () = ctx.arc(150.0, 150.0, 129.0, 0.0, 2*PI, true);
val () = ctx.closePath()
val () = ctx.stroke()
val () = ctx.restore(pf.0 | (*none*))
//
val () = ctx.strokeStyle("#222")
//
val pf = ctx.save()
//
val () = ctx.translate(150.0, 150.0)
//
val () = let
//
fun loop
(
  ctx: canvas2d, i: int
) : void =
(
if
i <= 60
then let
  val () =
  (
    if i % 5 != 0
      then draw_mark (ctx, i) else draw_mark2 (ctx, i)
    // end of [if]
  ) : void // end of [val]
in
  loop (ctx, i+1)
end // end of [then]
else () // end of [else]
) (* end of [loop] *)
//
in
  loop (ctx, 1)
end // end of [val]
//
val ampm =
  (if (nhr < 12.0) then "AM" else "PM"): string
//
val () = ctx.strokeStyle("#000")
val () = ctx.lineWidth(1)
val () = ctx.strokeRect(21.0, ~14.0, 44.0, 27.0)
val () = ctx.fillText(ampm, 43.0, 0.0)
val () = ctx.lineWidth(6)
//
val () =
{
  val pf = ctx.save()
  val () = ctx.rotate(nhr*PI/6)
  val () = ctx.beginPath()
  val () = ctx.moveTo(0.0, 10.0)
  val () = ctx.lineTo(0.0, ~60.0)
  val () = ctx.closePath()
  val () = ctx.stroke()
  val () = ctx.restore(pf.0 | (*none*))
} (* end of [val] *)
//
val () =
{
  val pf = ctx.save()
  val () = ctx.rotate(nmin*PI/30)
  val () = ctx.beginPath()
  val () = ctx.moveTo(0.0, 20.0)
  val () = ctx.lineTo(0.0, ~110.0)
  val () = ctx.closePath()
  val () = ctx.stroke()
  val () = ctx.restore(pf.0 | (*none*))
} (* end of [val] *)
//
val () = ctx.lineWidth (3)
val () = ctx.strokeStyle("#E33")
//
val () =
{
  val pf = ctx.save()
  val () = ctx.rotate(nsec*PI/30)
  val () = ctx.beginPath()
  val () = ctx.moveTo(0.0, 20.0)
  val () = ctx.lineTo(0.0, ~110.0)
  val () = ctx.closePath()
  val () = ctx.stroke()
  val () = ctx.restore(pf.0 | (*none*))
} (* end of [val] *)
//
val () = ctx.fillStyle("#000")
//
val () =
{
  val pf = ctx.save()
  val () = ctx.beginPath()
  val () = ctx.arc(0.0, 0.0, 6.5, 0.0, 2*PI, true)
  val () = ctx.closePath()
  val () = ctx.fill()
  val () = ctx.restore(pf.0 | (*none*))
} (* end of [val] *)
//
val () = ctx.restore (pf.0 | (*none*))
//
} (* end of [where] *) // [draw_clock]
//
(* ****** ****** *)

%{$
//
var
canvas =
document.getElementById("Patsoptaas-Evaluate-canvas");
var context = canvas.getContext( '2d' );
//
function
draw2_clock()
{
//
var w = canvas.width
var h = canvas.height
var xc = w / 2
var yc = h / 2
var wh = Math.min (w, h)
var alpha = wh / 300
//
var date = new Date() ;
var secs = date.getSeconds()
var mins = date.getMinutes()
var mins = mins + secs / 60.0
var hours = date.getHours()
var hours = hours + mins / 60.0
//
context.save();
context.translate(xc-wh/2, yc-wh/2);
context.scale (alpha, alpha);
draw_clock(context, hours, mins, secs);
context.restore();
//
setTimeout(draw2_clock, 500);
//
return;
//
} // end of [draw2_clock]
//
jQuery(document).ready(function(){draw2_clock();});
//
%} // end of [%{$]

(* ****** ****** *)

(* end of [myclock1-2.dats] *)

(*
//
An example of atscc2js: Wall Clock
//
Author: Hongwei Xi
Authoremail: hwxi AT cs DOT bu DOT edu
Start Time: September, 2014
//
This example is essentially translated from
the JS code at the following site:
//
http://www.neilwallis.com/projects/html5/clock/
//
*)

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)

#define ATS_DYNLOADFLAG 0

(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
#include
"{$LIBATSCC2JS}/staloadall.hats"
//
(* ****** ****** *)
//
staload
"{$LIBATSCC2JS}/SATS/HTML/canvas-2d/canvas2d.sats"
//
(* ****** ****** *)

macdef PI = JSmath_PI
macdef sin = JSmath_sin and cos = JSmath_cos

(* ****** ****** *)

fun
draw_mark
(
  ctx: canvas2d, i: int
) : void = {
//
val a = PI/30*i
val sa = sin(a)
val ca = cos(a)
val sx = 110 * sa
val sy = 110 * ca
val ex = 120 * sa
val ey = 120 * ca
//
val () = ctx.lineWidth(2)
//
val () = ctx.beginPath()
val () = ctx.moveTo(sx, sy)
val () = ctx.lineTo(ex, ey)
val () = ctx.closePath()
//
val () = ctx.stroke()
//
} (* end of [draw_mark] *)

(* ****** ****** *)

fun
draw_mark2
(
  ctx: canvas2d, i: int
) : void = {
//
val a = PI/30*i
val sa = sin(a)
val ca = cos(a)
val sx =  95 * sa
val sy = ~95 * ca
val ex =  120 * sa
val ey = ~120 * ca
val nx =  80 * sa
val ny = ~80 * ca
//
val () = ctx.fillText(toString(i/5), nx, ny)
//
val () = ctx.lineWidth(8)
//
val () = ctx.beginPath()
val () = ctx.moveTo(sx, sy)
val () = ctx.lineTo(ex, ey)
val () = ctx.closePath()
//
val () = ctx.stroke()
//
} (* end of [draw_mark2] *)

(* ****** ****** *)
//
extern
fun
draw_clock
(
  ctx: canvas2d
, nhr: double, nmin: double, nsec: double
) : void = "mac#" // end-of-fun
//
implement
draw_clock
(
  ctx, nhr, nmin, nsec
) = () where {
//
val () = ctx.clearRect(0.0, 0.0, 300.0, 300.0)
//
// Define gradients for 3D-shadow effect
//
val g1 = ctx.createLinearGradient(0.0, 0.0, 300.0, 300.0)
val () = g1.addColorStop(0.0, "#D83040")
val () = g1.addColorStop(1.0, "#801020")
//
val g2 = ctx.createLinearGradient(0.0, 0.0, 300.0, 300.0)
val () = g2.addColorStop(0.0, "#801020")
val () = g2.addColorStop(1.0, "#D83040")
//
val () = ctx.font("bold 20px arial")
val () = ctx.textAlign("center")
val () = ctx.textBaseline("middle")
val () = ctx.lineWidth(1)
//
val () = ctx.strokeStyle_gradient(g1)
val () = ctx.lineWidth(10)
//
val pf = ctx.save()
val () = ctx.beginPath()
val () = ctx.arc(150.0, 150.0, 138.0, 0.0, 2*PI, true)
val () = ctx.closePath()
val () = ctx.shadowBlur(6)
val () = ctx.shadowOffsetX(4)
val () = ctx.shadowOffsetY(4)
val () = ctx.shadowColor("rgba(0,0,0,0.6)")
val () = ctx.stroke()
val () = ctx.restore(pf.0 | (*none*))
//
val () = ctx.strokeStyle_gradient(g2)
val () = ctx.lineWidth(10)
//
val pf = ctx.save()
val () = ctx.beginPath()
val () = ctx.arc(150.0, 150.0, 129.0, 0.0, 2*PI, true);
val () = ctx.closePath()
val () = ctx.stroke()
val () = ctx.restore(pf.0 | (*none*))
//
val () = ctx.strokeStyle("#222")
//
val pf = ctx.save()
//
val () = ctx.translate(150.0, 150.0)
//
val () = let
//
fun loop
(
  ctx: canvas2d, i: int
) : void =
(
if
i <= 60
then let
  val () =
  (
    if i % 5 != 0
      then draw_mark (ctx, i) else draw_mark2 (ctx, i)
    // end of [if]
  ) : void // end of [val]
in
  loop (ctx, i+1)
end // end of [then]
else () // end of [else]
) (* end of [loop] *)
//
in
  loop (ctx, 1)
end // end of [val]
//
val ampm =
  (if (nhr < 12.0) then "AM" else "PM"): string
//
val () = ctx.strokeStyle("#000")
val () = ctx.lineWidth(1)
val () = ctx.strokeRect(21.0, ~14.0, 44.0, 27.0)
val () = ctx.fillText(ampm, 43.0, 0.0)
val () = ctx.lineWidth(6)
//
val () =
{
  val pf = ctx.save()
  val () = ctx.rotate(nhr*PI/6)
  val () = ctx.beginPath()
  val () = ctx.moveTo(0.0, 10.0)
  val () = ctx.lineTo(0.0, ~60.0)
  val () = ctx.closePath()
  val () = ctx.stroke()
  val () = ctx.restore(pf.0 | (*none*))
} (* end of [val] *)
//
val () =
{
  val pf = ctx.save()
  val () = ctx.rotate(nmin*PI/30)
  val () = ctx.beginPath()
  val () = ctx.moveTo(0.0, 20.0)
  val () = ctx.lineTo(0.0, ~110.0)
  val () = ctx.closePath()
  val () = ctx.stroke()
  val () = ctx.restore(pf.0 | (*none*))
} (* end of [val] *)
//
val () = ctx.lineWidth (3)
val () = ctx.strokeStyle("#E33")
//
val () =
{
  val pf = ctx.save()
  val () = ctx.rotate(nsec*PI/30)
  val () = ctx.beginPath()
  val () = ctx.moveTo(0.0, 20.0)
  val () = ctx.lineTo(0.0, ~110.0)
  val () = ctx.closePath()
  val () = ctx.stroke()
  val () = ctx.restore(pf.0 | (*none*))
} (* end of [val] *)
//
val () = ctx.fillStyle("#000")
//
val () =
{
  val pf = ctx.save()
  val () = ctx.beginPath()
  val () = ctx.arc(0.0, 0.0, 6.5, 0.0, 2*PI, true)
  val () = ctx.closePath()
  val () = ctx.fill()
  val () = ctx.restore(pf.0 | (*none*))
} (* end of [val] *)
//
val () = ctx.restore (pf.0 | (*none*))
//
} (* end of [where] *) // [draw_clock]
//
(* ****** ****** *)

%{$
//
var
canvas =
document.getElementById("Patsoptaas-Evaluate-canvas");
var context = canvas.getContext( '2d' );
//
var w = canvas.width
var h = canvas.height
var xc = w / 2
var yc = h / 2
var wh = Math.min (w, h)
var alpha = wh / 300
//
function
draw2_clock()
{
var date = new Date() ;
var secs = date.getSeconds()
var mins = date.getMinutes()
var mins = mins + secs / 60.0
var hours = date.getHours()
var hours = hours + mins / 60.0
//
context.save();
context.translate(xc-wh/2, yc-wh/2);
context.scale (alpha, alpha);
draw_clock(context, hours, mins, secs);
context.restore();
//
setTimeout(draw2_clock, 500);
//
return;
//
} // end of [draw2_clock]
//
jQuery(document).ready(function(){draw2_clock();});
//
%} // end of [%{$]

(* ****** ****** *)

(* end of [myclock1-2.dats] *)


Updating: very minorly improving

Updating: very minorly improving

(*
** Session Array
*)

(* ****** ****** *)
//
#define ATS_DYNLOADFLAG 0
//
(* ****** ****** *)
//
#define
ATS_EXTERN_PREFIX "libats2erl_session_"
#define
ATS_STATIC_PREFIX "_libats2erl_session_ssarray_"
//
(* ****** ****** *)
//
#include "share/atspre_define.hats"
#include "{$LIBATSCC2ERL}/staloadall.hats"
//
(* ****** ****** *)
//
staload
UN =
"prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
staload "./../SATS/basis.sats"
staload "./../SATS/ssarray.sats"
//
(* ****** ****** *)
//
staload CHAN0 = "./basis_chan0.dats"
//
macdef
chanpos0_send = $CHAN0.chanpos0_send
macdef
chanpos0_recv = $CHAN0.chanpos0_recv
macdef
channeg0_recv = $CHAN0.channeg0_recv
macdef
channeg0_send = $CHAN0.channeg0_send
//
vtypedef chanpos0 = $CHAN0.chanpos()
vtypedef channeg0 = $CHAN0.channeg()
//
(* ****** ****** *)

implement
chanpos_arrsz
  {a}{n}(chp, n) = let
//
typedef
ss = chsnd(int)::ssarray(a,n)
prval() =
  $UN.castview2void{chanpos(ss)}(chp)
//
in
  chanpos_send{int}(chp, n)
end // end of [chanpos_arrsz]

(* ****** ****** *)

implement
channeg_arrsz
  {a}(chn) = asz where
{
//
prval
[n:int](_) = g1ofg0(0)
//
typedef
ss = chsnd(int)::ssarray(a,n)
prval() =
  $UN.castview2void{channeg(ss)}(chn)
//
val
asz = channeg_send{int}(chn)
//
val
[n:int]
asz = $UN.cast{intGte(0)}(asz)
//
prval() =
  $UN.castview2void{channeg(ssarray(a,n))}(chn)
//
} (* end of [channeg_arrsz] *)

(* ****** ****** *)
//
implement
ssarray2list
  {a}(chn, n) =
  list_vt2t(ssarray2list_vt(chn, n))
//
(* ****** ****** *)

implement
list2ssarray
  {a}(xs) = let
//
fun
fserv{n:int}
(
  chp: chanpos(ssarray(a, n)), xs: list(a, n)
) : void =
(
case+ xs of
| list_nil () => let
    prval() =
    chanpos_array_nil(chp)
  in
    chanpos_nil_wait (chp)
  end // end of [nil]
| list_cons (x, xs) => let
    prval() =
    chanpos_array_cons(chp)
    val () = chanpos_send{a}(chp, x)
  in
    fserv(chp, xs)
  end // end of [cons]
) (* end of [fserv] *)
//
in
  channeg_create(llam(chp) => fserv(chp, xs))
end // end of [list2ssarray]

(* ****** ****** *)

implement
list2ssarray_vt
  {a}(xs) = let
//
fun
fserv{n:int}
(
  chp: chanpos(ssarray(a, n)), xs: list_vt(a, n)
) : void =
(
case+ xs of
| ~nil_vt () => let
    prval() =
    chanpos_array_nil(chp)
  in
    chanpos_nil_wait (chp)
  end // end of [nil]
| ~cons_vt (x, xs) => let
    prval() =
    chanpos_array_cons(chp)
    val () = chanpos_send{a}(chp, x)
  in
    fserv(chp, xs)
  end // end of [cons]
) (* end of [fserv] *)
//
in
  channeg_create(llam(chp) => fserv(chp, xs))
end // end of [list2ssarray_vt]

(* ****** ****** *)

implement
ssarray2list_vt
  {a}{n}(chn, n) = xs where
{
//
prval
() = $UN.prop_assert{n >= 0}()
//
val xs =
channeg_array_takeout_list{a}(chn, n)
//
prval() = channeg_array_nil (chn)
val ((*closed*)) = channeg_nil_close (chn)
//
} (* end of [ssarray2list_vt] *)

(* ****** ****** *)

implement
channeg_array_takeout_list
  {a}{n}{i}(chn, i) = let
//
vtypedef
chan(n:int) = channeg(ssarray(a, n))
//
fun
revapp
{i,j:nat}
(
  xs: list_vt(a, i)
, ys: list_vt(a, j)
) : list_vt(a, i+j) =
(
case+ xs of
| ~nil_vt() => ys
| ~cons_vt(x, xs) =>
    revapp(xs, list_vt_cons{a}(x, ys))
  // end of [cons_vt]
) (* end of [revapp] *)
//
fun
loop
{n:int}
{i,j:nat | i <= n}
(
  chn:
  !chan(n) >> chan(n-i)
, i: int(i), res: list_vt(a, j)
) : list_vt(a, i+j) = (
//
if
i > 0
then let
//
prval() =
  channeg_array_cons(chn)
//
val x0 = channeg_send{a}(chn)
//
in
//
loop(chn, i-1, list_vt_cons{a}(x0, res))
//
end // end of [then]
else res // end of [else]
//
) (* end of [loop] *)
//
in
  revapp(loop(chn, i, list_vt_nil), list_vt_nil)
end // end of [channeg_array_takeout_list]

(* ****** ****** *)

(* end of [ssarray.dats] *)

(*
** Session Array
*)

(* ****** ****** *)
//
#define ATS_DYNLOADFLAG 0
//
(* ****** ****** *)
//
#define
ATS_EXTERN_PREFIX "libats2erl_session_"
#define
ATS_STATIC_PREFIX "_libats2erl_session_ssarray_"
//
(* ****** ****** *)
//
#include "share/atspre_define.hats"
#include "{$LIBATSCC2ERL}/staloadall.hats"
//
(* ****** ****** *)
//
staload
UN =
"prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
staload "./../SATS/basis.sats"
staload "./../SATS/ssarray.sats"
//
(* ****** ****** *)
//
staload
"./basis_chan0.dats" // un-typed channels
//
(* ****** ****** *)

implement
chanpos_arrsz
  {a}{n}(chp, n) = let
//
typedef
ss = chsnd(int)::ssarray(a,n)
prval() =
  $UN.castview2void{chanpos(ss)}(chp)
//
in
  chanpos_send{int}(chp, n)
end // end of [chanpos_arrsz]

(* ****** ****** *)

implement
channeg_arrsz
  {a}(chn) = asz where
{
//
prval
[n:int](_) = g1ofg0(0)
//
typedef
ss = chsnd(int)::ssarray(a,n)
prval() =
  $UN.castview2void{channeg(ss)}(chn)
//
val
asz = channeg_send{int}(chn)
//
val
[n:int]
asz = $UN.cast{intGte(0)}(asz)
//
prval() =
  $UN.castview2void{channeg(ssarray(a,n))}(chn)
//
} (* end of [channeg_arrsz] *)

(* ****** ****** *)
//
implement
ssarray2list
  {a}(chn, n) =
  list_vt2t(ssarray2list_vt(chn, n))
//
(* ****** ****** *)

implement
list2ssarray
  {a}(xs) = let
//
fun
fserv{n:int}
(
  chp: chanpos(ssarray(a, n)), xs: list(a, n)
) : void =
(
case+ xs of
| list_nil () => let
    prval() =
    chanpos_array_nil(chp)
  in
    chanpos_nil_wait (chp)
  end // end of [nil]
| list_cons (x, xs) => let
    prval() =
    chanpos_array_cons(chp)
    val () = chanpos_send{a}(chp, x)
  in
    fserv(chp, xs)
  end // end of [cons]
) (* end of [fserv] *)
//
in
  channeg_create(llam(chp) => fserv(chp, xs))
end // end of [list2ssarray]

(* ****** ****** *)

implement
list2ssarray_vt
  {a}(xs) = let
//
fun
fserv{n:int}
(
  chp: chanpos(ssarray(a, n)), xs: list_vt(a, n)
) : void =
(
case+ xs of
| ~nil_vt () => let
    prval() =
    chanpos_array_nil(chp)
  in
    chanpos_nil_wait (chp)
  end // end of [nil]
| ~cons_vt (x, xs) => let
    prval() =
    chanpos_array_cons(chp)
    val () = chanpos_send{a}(chp, x)
  in
    fserv(chp, xs)
  end // end of [cons]
) (* end of [fserv] *)
//
in
  channeg_create(llam(chp) => fserv(chp, xs))
end // end of [list2ssarray_vt]

(* ****** ****** *)

implement
ssarray2list_vt
  {a}{n}(chn, n) = xs where
{
//
prval
() = $UN.prop_assert{n >= 0}()
//
val xs =
channeg_array_takeout_list{a}(chn, n)
//
prval() = channeg_array_nil (chn)
val ((*closed*)) = channeg_nil_close (chn)
//
} (* end of [ssarray2list_vt] *)

(* ****** ****** *)

implement
channeg_array_takeout_list
  {a}{n}{i}(chn, i) = let
//
vtypedef
chan(n:int) = channeg(ssarray(a, n))
//
fun
revapp
{i,j:nat}
(
  xs: list_vt(a, i)
, ys: list_vt(a, j)
) : list_vt(a, i+j) =
(
case+ xs of
| ~nil_vt() => ys
| ~cons_vt(x, xs) =>
    revapp(xs, list_vt_cons{a}(x, ys))
  // end of [cons_vt]
) (* end of [revapp] *)
//
fun
loop
{n:int}
{i,j:nat | i <= n}
(
  chn:
  !chan(n) >> chan(n-i)
, i: int(i), res: list_vt(a, j)
) : list_vt(a, i+j) = (
//
if
i > 0
then let
//
prval() =
  channeg_array_cons(chn)
//
val x0 = channeg_send{a}(chn)
//
in
//
loop(chn, i-1, list_vt_cons{a}(x0, res))
//
end // end of [then]
else res // end of [else]
//
) (* end of [loop] *)
//
in
  revapp(loop(chn, i, list_vt_nil), list_vt_nil)
end // end of [channeg_array_takeout_list]

(* ****** ****** *)

(* end of [ssarray.dats] *)


Updating: very minorly improving

Updating: very minorly improving

(*
**
** For testing g-sessions
**
** This example involves 4 parties,
** passing 4 messages in a ring-like
** fashion.
**
** Author: Hongwei Xi
** Authoremail: gmhwxiATgmailDOTcom
** Start time: the 8th of March, 2016
**
*)

(* ****** ****** *)

%{^
//
#include <pthread.h>
//
%} // end of [%{^]

(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)

staload UN = $UNSAFE

(* ****** ****** *)

staload
UNISTD = "libc/SATS/unistd.sats"

(* ****** ****** *)

staload
"./../SATS/basis_intset.sats"
staload _ =
"./../DATS/basis_intset.dats"

(* ****** ****** *)
//
staload
"./../SATS/basis_ssntype.sats"
staload
"./../SATS/basis_ssntype2r.sats"
//
(* ****** ****** *)
//
staload _ =
"libats/DATS/deqarray.dats"
//
(* ****** ****** *)
//
staload _ =
"libats/DATS/athread.dats"
staload _ =
"libats/DATS/athread_posix.dats"
//
(* ****** ****** *)
//
staload _ =
"./../DATS/basis_uchan.dats"
staload _ =
"./../DATS/basis_channel0.dats"
staload _ =
"./../DATS/basis_channel1.dats"
staload _ =
"./../DATS/basis_ssntype2r.dats"
//
(* ****** ****** *)

#define N 4

(* ****** ****** *)
//
typedef
ssn_ring4 =
msg(0, 1, string) ::
msg(1, 2, string) ::
msg(2, 3, string) ::
msg(3, 0, string) :: nil
//
(* ****** ****** *)
//
stadef S0 = iset(0)
stadef S1 = iset(1)
stadef S2 = iset(2)
stadef S3 = iset(3)
//
stadef S02 = iset(0,2)
stadef S13 = iset(1,3)
//
(* ****** ****** *)
//
fun
fserv_client0
(
  chan:
  channel1(S0, N, ssn_ring4)
) : void =
{
//
prval() =
lemma_iset_sing_is_member{0}()
prval() =
lemma_iset_sing_isnot_member{0,1}()
prval() =
lemma_iset_sing_isnot_member{0,2}()
prval() =
lemma_iset_sing_isnot_member{0,3}()
//
val () =
channel1_send
  (chan, 0, 1, "msg(0, 1)")
//
val () = channel1_skipex(chan)
val () = channel1_skipex(chan)
//
val
msg = channel1_recv_val(chan, 3, 0)
val () = println! ("client0: msg = ", msg)
//
val () = channel1_close(chan)
//
} (* end of [fserv_client0] *)
//
(* ****** ****** *)
//
fun
fserv_client1
(
  chan:
  channel1(S1, N, ssn_ring4)
) : void =
{
//
prval() =
lemma_iset_sing_is_member{1}()
prval() =
lemma_iset_sing_isnot_member{1,0}()
prval() =
lemma_iset_sing_isnot_member{1,2}()
prval() =
lemma_iset_sing_isnot_member{1,3}()
//
val
msg =
channel1_recv_val(chan, 0, 1)
val () =
println! ("client1: msg = ", msg)
//
val () =
channel1_send(chan, 1, 2, "msg(1, 2)")
//
val () = channel1_skipex(chan)
val () = channel1_skipex(chan)
//
val () = channel1_close(chan)
//
} (* end of [fserv_client1] *)
//
(* ****** ****** *)
//
fun
fserv_client2
(
  chan:
  channel1(S2, N, ssn_ring4)
) : void =
{
//
prval() =
lemma_iset_sing_is_member{2}()
prval() =
lemma_iset_sing_isnot_member{2,0}()
prval() =
lemma_iset_sing_isnot_member{2,1}()
prval() =
lemma_iset_sing_isnot_member{2,3}()
//
val () =
  channel1_skipex(chan)
//
val
msg =
channel1_recv_val(chan, 1, 2)
val () =
println! ("client2: msg = ", msg)
//
val () =
channel1_send(chan, 2, 3, "msg(2, 3)")
//
val () = channel1_skipex(chan)
//
val () = channel1_close(chan)
//
} (* end of [fserv_client2] *)
//
(* ****** ****** *)
//
fun
fserv_client3
(
  chan:
  channel1(S3, N, ssn_ring4)
) : void =
{
//
prval() =
lemma_iset_sing_is_member{3}()
prval() =
lemma_iset_sing_isnot_member{3,0}()
prval() =
lemma_iset_sing_isnot_member{3,1}()
prval() =
lemma_iset_sing_isnot_member{3,2}()
//
val () =
  channel1_skipex(chan)
val () =
  channel1_skipex(chan)
//
val
msg =
channel1_recv_val(chan, 2, 3)
val () =
println!("client3: msg = ", msg)
//
val () =
channel1_send(chan, 3, 0, "msg(3, 0)")
//
val () = channel1_close(chan)
//
} (* end of [fserv_client3] *)
//
(* ****** ****** *)

implement
main0
(
  argc, argv
) = let
//
val S0 = intset_int{N}(0)
val S1 = intset_int{N}(1)
val S2 = intset_int{N}(2)
val S3 = intset_int{N}(3)
//
val chn0 =
cchannel1_create_exn
(
  N, S0, llam(chp) => fserv_client0(chp)
) (* end of [val] *)
val chn2 =
cchannel1_create_exn
(
  N, S2, llam(chp) => fserv_client2(chp)
) (* end of [val] *)
//
val chn1 =
cchannel1_create_exn
(
  N, S1, llam(chp) => fserv_client1(chp)
) (* end of [val] *)
val chn3 =
cchannel1_create_exn
(
  N, S3, llam(chp) => fserv_client3(chp)
) (* end of [val] *)
//
val () =
channel1_link_elim
(
  channel1_link(chn0, $UN.castvwtp0(chn2))
, channel1_link(chn1, $UN.castvwtp0(chn3))
) (* end of [val] *)
//
in
<<<<<<< HEAD
  ignoret($UNISTD.usleep(250000u)) // wait until the 4 threads finish
=======
  ignoret($UNISTD.usleep(250000u))
>>>>>>> c28772a91c84b274e4949aa92626461b8a513f39
end // end of [main0]

(* ****** ****** *)

<<<<<<< HEAD
(* end of [test03-4p.dats] *)
=======
(* end of [test02-3p.dats] *)
>>>>>>> c28772a91c84b274e4949aa92626461b8a513f39

(*
**
** For testing g-sessions
**
** This example involves 4 parties,
** passing 4 messages in a ring-like
** fashion.
**
** Author: Hongwei Xi
** Authoremail: gmhwxiATgmailDOTcom
** Start time: the 8th of March, 2016
**
*)

(* ****** ****** *)

%{^
//
#include <pthread.h>
//
%} // end of [%{^]

(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)

staload UN = $UNSAFE

(* ****** ****** *)

staload
UNISTD = "libc/SATS/unistd.sats"

(* ****** ****** *)

staload
"./../SATS/basis_intset.sats"
staload _ =
"./../DATS/basis_intset.dats"

(* ****** ****** *)
//
staload
"./../SATS/basis_ssntype.sats"
staload
"./../SATS/basis_ssntype2r.sats"
//
(* ****** ****** *)
//
staload _ =
"libats/DATS/deqarray.dats"
//
(* ****** ****** *)
//
staload _ =
"libats/DATS/athread.dats"
staload _ =
"libats/DATS/athread_posix.dats"
//
(* ****** ****** *)
//
staload _ =
"./../DATS/basis_uchan.dats"
staload _ =
"./../DATS/basis_channel0.dats"
staload _ =
"./../DATS/basis_channel1.dats"
staload _ =
"./../DATS/basis_ssntype2r.dats"
//
(* ****** ****** *)

#define N 4

(* ****** ****** *)
//
typedef
ssn_ring4 =
msg(0, 1, string) ::
msg(1, 2, string) ::
msg(2, 3, string) ::
msg(3, 0, string) :: nil
//
(* ****** ****** *)
//
stadef S0 = iset(0)
stadef S1 = iset(1)
stadef S2 = iset(2)
stadef S3 = iset(3)
//
stadef S02 = iset(0,2)
stadef S13 = iset(1,3)
//
(* ****** ****** *)
//
fun
fserv_client0
(
  chan:
  channel1(S0, N, ssn_ring4)
) : void =
{
//
prval() =
lemma_iset_sing_is_member{0}()
prval() =
lemma_iset_sing_isnot_member{0,1}()
prval() =
lemma_iset_sing_isnot_member{0,2}()
prval() =
lemma_iset_sing_isnot_member{0,3}()
//
val () =
channel1_send
  (chan, 0, 1, "msg(0, 1)")
//
val () = channel1_skipex(chan)
val () = channel1_skipex(chan)
//
val
msg = channel1_recv_val(chan, 3, 0)
val () = println! ("client0: msg = ", msg)
//
val () = channel1_close(chan)
//
} (* end of [fserv_client0] *)
//
(* ****** ****** *)
//
fun
fserv_client1
(
  chan:
  channel1(S1, N, ssn_ring4)
) : void =
{
//
prval() =
lemma_iset_sing_is_member{1}()
prval() =
lemma_iset_sing_isnot_member{1,0}()
prval() =
lemma_iset_sing_isnot_member{1,2}()
prval() =
lemma_iset_sing_isnot_member{1,3}()
//
val
msg =
channel1_recv_val(chan, 0, 1)
val () =
println! ("client1: msg = ", msg)
//
val () =
channel1_send(chan, 1, 2, "msg(1, 2)")
//
val () = channel1_skipex(chan)
val () = channel1_skipex(chan)
//
val () = channel1_close(chan)
//
} (* end of [fserv_client1] *)
//
(* ****** ****** *)
//
fun
fserv_client2
(
  chan:
  channel1(S2, N, ssn_ring4)
) : void =
{
//
prval() =
lemma_iset_sing_is_member{2}()
prval() =
lemma_iset_sing_isnot_member{2,0}()
prval() =
lemma_iset_sing_isnot_member{2,1}()
prval() =
lemma_iset_sing_isnot_member{2,3}()
//
val () =
  channel1_skipex(chan)
//
val
msg =
channel1_recv_val(chan, 1, 2)
val () =
println! ("client2: msg = ", msg)
//
val () =
channel1_send(chan, 2, 3, "msg(2, 3)")
//
val () = channel1_skipex(chan)
//
val () = channel1_close(chan)
//
} (* end of [fserv_client2] *)
//
(* ****** ****** *)
//
fun
fserv_client3
(
  chan:
  channel1(S3, N, ssn_ring4)
) : void =
{
//
prval() =
lemma_iset_sing_is_member{3}()
prval() =
lemma_iset_sing_isnot_member{3,0}()
prval() =
lemma_iset_sing_isnot_member{3,1}()
prval() =
lemma_iset_sing_isnot_member{3,2}()
//
val () =
  channel1_skipex(chan)
val () =
  channel1_skipex(chan)
//
val
msg =
channel1_recv_val(chan, 2, 3)
val () =
println!("client3: msg = ", msg)
//
val () =
channel1_send(chan, 3, 0, "msg(3, 0)")
//
val () = channel1_close(chan)
//
} (* end of [fserv_client3] *)
//
(* ****** ****** *)

implement
main0
(
  argc, argv
) = let
//
val S0 = intset_int{N}(0)
val S1 = intset_int{N}(1)
val S2 = intset_int{N}(2)
val S3 = intset_int{N}(3)
//
val chn0 =
cchannel1_create_exn
(
  N, S0, llam(chp) => fserv_client0(chp)
) (* end of [val] *)
val chn2 =
cchannel1_create_exn
(
  N, S2, llam(chp) => fserv_client2(chp)
) (* end of [val] *)
//
val chn1 =
cchannel1_create_exn
(
  N, S1, llam(chp) => fserv_client1(chp)
) (* end of [val] *)
val chn3 =
cchannel1_create_exn
(
  N, S3, llam(chp) => fserv_client3(chp)
) (* end of [val] *)
//
val () =
channel1_link_elim
(
  channel1_link(chn0, $UN.castvwtp0(chn2))
, channel1_link(chn1, $UN.castvwtp0(chn3))
) (* end of [val] *)
//
in
  ignoret($UNISTD.usleep(250000u)) // wait until the 4 threads finish
end // end of [main0]

(* ****** ****** *)

(* end of [test03-4p.dats] *)


Updating: very minorly fixing

Updating: very minorly fixing

(*
#
# ArrayQuickSort
#
*)
(* ****** ****** *)

#define ATS_DYNLOADFLAG 0

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
#include
"{$ARDUINO}/staloadall.hats"
//
(* ****** ****** *)

staload UN = "prelude/SATS/unsafe.sats"

(* ****** ****** *)
//
%{^
typedef char *charptr;
%} // end of [%{^]
//
abstype charptr = $extype"charptr"
//
(* ****** ****** *)
//
%{^
#define N 10
int theArray[N] =
{
  0,1,2,3,4,5,6,7,8,9
} ;
%} // end of [%{^]
#define N 10
macdef theArray =
  $extval(arrayref(int,N),"theArray")
//
(* ****** ****** *)

macdef LEDPIN = 13
macdef BAUD_RATE = 9600

(* ****** ****** *)
//
extern
fun
setup (): void = "mac#"
//
implement
setup () = () where
{
//
val () = pinMode(LEDPIN, OUTPUT)
val () = Serial_ptr._begin(BAUD_RATE)
//
} (* end of [setup] *)
//
(* ****** ****** *)
//
implement
fprint_val<int>
  (out, x) = Serial_ptr.print(x)
//
(* ****** ****** *)
//
(*
implement
fprint_string (out, x) = Serial_ptr.print(x)
*)
(* ****** ****** *)
//
implement
fprint_array$sep<> (out) = ()
//
(* ****** ****** *)
//
extern
fun loop (): void = "mac#"
//
implement
loop () =
myloop(0) where
{
//
fun
mysort{n:nat}
(
  A: arrayref(int, n)
, n: int(n)
) : void = let
//
val
(
  vbox pf | p
) =
  arrayref_get_viewptr(A)
in
  array_quicksort (!p, i2sz(n))
end // end of [mysort]
//
fun
myrand{n:int}
(
  A: arrayref(int, n), n: int(n)
) : void = let
//
val
(
  vbox pf | p
) =
  arrayref_get_viewptr(A)
//
prval () = lemma_arrayref_param(A)
//
implement
array_permute$randint<>
  {n}(n) =
(
  $UN.cast{sizeLt(n)}(random(sz2i(n)))
) (* end of [array_permute$randint] *)
//
in
  $effmask_ref(array_permute (!p, i2sz(n)))
end // end of [myrand]
//
fun
myloop
(
  bit: int
) : void = let
//
val
out = $extval (FILEref, "0")
//
(*
val () =
randomSeed($UN.cast{uint}(millis()))
*)
//
val A = theArray
val () = fprint_arrayref (out, A, i2sz(N))
val () = Serial_ptr.println()
//
val () =
(
  if bit = 0 then myrand(A, N) else mysort(A, N)
) : void // end of [val]
//
val () = digitalWrite(LEDPIN, 1)
val () = delay(250)
val () = digitalWrite(LEDPIN, 0)
val () = delay(1000)
//
in
  myloop (1-bit)
end // end of [myloop]
//
} (* end of [loop] *)
//
(* ****** ****** *)

(* end of [ArrayQuickSort.dats] *)

(*
#
# ArrayQuickSort
#
*)
(* ****** ****** *)

#define ATS_DYNLOADFLAG 0

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
#include
"{$ARDUINO}/staloadall.hats"
//
(* ****** ****** *)
//
staload _ =
  "prelude/DATS/array_quicksort.dats"
//
(* ****** ****** *)

staload UN = "prelude/SATS/unsafe.sats"

(* ****** ****** *)
//
%{^
typedef char *charptr;
%} // end of [%{^]
//
abstype charptr = $extype"charptr"
//
(* ****** ****** *)
//
%{^
#define N 10
int theArray[N] =
{
  0,1,2,3,4,5,6,7,8,9
} ;
%} // end of [%{^]
#define N 10
macdef theArray =
  $extval(arrayref(int,N),"theArray")
//
(* ****** ****** *)

macdef LEDPIN = 13
macdef BAUD_RATE = 9600

(* ****** ****** *)
//
extern
fun
setup (): void = "mac#"
//
implement
setup () = () where
{
//
val () = pinMode(LEDPIN, OUTPUT)
val () = Serial_ptr._begin(BAUD_RATE)
//
} (* end of [setup] *)
//
(* ****** ****** *)
//
implement
fprint_val<int>
  (out, x) = Serial_ptr.print(x)
//
(* ****** ****** *)
//
(*
implement
fprint_string (out, x) = Serial_ptr.print(x)
*)
(* ****** ****** *)
//
implement
fprint_array$sep<> (out) = ()
//
(* ****** ****** *)
//
extern
fun loop (): void = "mac#"
//
implement
loop () =
myloop(0) where
{
//
fun
mysort{n:nat}
(
  A: arrayref(int, n)
, n: int(n)
) : void = let
//
val
(
  vbox pf | p
) =
  arrayref_get_viewptr(A)
in
  array_quicksort (!p, i2sz(n))
end // end of [mysort]
//
fun
myrand{n:int}
(
  A: arrayref(int, n), n: int(n)
) : void = let
//
val
(
  vbox pf | p
) =
  arrayref_get_viewptr(A)
//
prval () = lemma_arrayref_param(A)
//
implement
array_permute$randint<>
  {n}(n) =
(
  $UN.cast{sizeLt(n)}(random(sz2i(n)))
) (* end of [array_permute$randint] *)
//
in
  $effmask_ref(array_permute (!p, i2sz(n)))
end // end of [myrand]
//
fun
myloop
(
  bit: int
) : void = let
//
val
out = $extval (FILEref, "0")
//
(*
val () =
randomSeed($UN.cast{uint}(millis()))
*)
//
val A = theArray
val () = fprint_arrayref (out, A, i2sz(N))
val () = Serial_ptr.println()
//
val () =
(
  if bit = 0 then myrand(A, N) else mysort(A, N)
) : void // end of [val]
//
val () = digitalWrite(LEDPIN, 1)
val () = delay(250)
val () = digitalWrite(LEDPIN, 0)
val () = delay(1000)
//
in
  myloop (1-bit)
end // end of [myloop]
//
} (* end of [loop] *)
//
(* ****** ****** *)

(* end of [ArrayQuickSort.dats] *)


Updating: working on chardev-1

Updating: working on chardev-1

(*
** A simple char device
*)

(* ****** ****** *)
//
// HX-2014-10-24:
// nothing fancy here;
// just trying to get it working
//
(* ****** ****** *)
//
// HX-2014-10-21:
// no use for dynloading
//
#define ATS_DYNLOADFLAG 0
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
#include
"{$KERNELATS}/prelude/staloadall.hats"
//
(* ****** ****** *)
//
staload
"{$LINUX}/basics.sats"
//
(* ****** ****** *)
//
staload
"{$LINUX}/SATS/errno.sats"
staload
"{$LINUX}/SATS/types.sats"
//
(* ****** ****** *)
//
staload
"{$LINUX}/SATS/init.sats"
staload
"{$LINUX}/SATS/module.sats"
staload
"{$LINUX}/SATS/kernel.sats"
staload $PRINTK // HX: opening NS
//
staload "{$LINUX}/SATS/fs.sats"
//
staload "{$LINUX}/SATS/asm/uaccess.sats"
//
(* ****** ****** *)

staload
UN = "prelude/SATS/unsafe.sats"

(* ****** ****** *)

%{^
MODULE_LICENSE("Dual BSD/GPL") ;
%} // end of [%{^]

(* ****** ****** *)

static
fun init_module(): interr = "mac#"
static
fun cleanup_module(): void = "mac#"

(* ****** ****** *)

%{^
static int Major = 0;
static int Device_open = 0;
static int Device_open_count = 0;
%} // end of [%{^]

macdef
Major = $extval(int, "Major")
macdef
Device_open = $extval(int, "Device_open")
macdef
Device_open_count = $extval(int, "Device_open_count")

(* ****** ****** *)

%{^
#define BUFLEN 80 // Max length of the message from the device
#define DEVICE_NAME "chardev-1" /* Dev name as it appears in /proc/devices */
//
typedef
char *charptr ;
char Message[BUFLEN];
charptr Message0_ptr = &Message[0];
charptr Message1_ptr = &Message[0];
//
%} // end of [%{^]

typedef charptr = $extype"charptr"

macdef
DEVICE_NAME = $extval(string, "DEVICE_NAME")
macdef
Message0_ptr = $extval(charptr, "Message0_ptr")
macdef
Message1_ptr = $extval(charptr, "Message1_ptr")

(* ****** ****** *)

%{^
//
static int device_open(struct inode *, struct file *);
static int device_release(struct inode *, struct file *);
static ssize_t device_read(struct file *, char *, size_t, loff_t *);
static ssize_t device_write(struct file *, const char *, size_t, loff_t *);
//
%} // end of [%{^]

(* ****** ****** *)

%{^

struct
file_operations
fops = {
  .read = device_read,
  .write = device_write,
  .open = device_open,
  .release = device_release
} ;

static void *fops_ptr = &(fops);

%} // end of [%{^]

macdef
fops_ptr = $extval(fops_ptr1, "fops_ptr")

(* ****** ****** *)

implement
init_module
(
) = let
//
extvar
"Major" =
register_chrdev(0u, DEVICE_NAME, fops_ptr)
//
val Major = g1ofg0(Major)
//
in
//
if
(Major > 0)
then let
//
val () =
$extfcall
(
  void
, "printk", KERN_INFO_"The assigned major number is: %d\n", Major
) (* end of [val] *)
//
in
  0(*SUCCESS*)
end // end of [then]
else let
//
val () =
$extfcall
(
  void
, "printk", KERN_ALERT_"Registering chardev failed with %d\n", Major
) (* end of [val] *)
//
in
  Major
end // end of [else]
//
end (* end of [init_module] *)

(* ****** ****** *)

implement
cleanup_module
(
// argumentless
) = () where
{
//
val
Major =
(
if Major > 0
  then g0i2u(Major) else 0u
// end of [if]
) : uint // end of [val]
//
val () = unregister_chrdev(Major, DEVICE_NAME)
//
} (* end of [cleanup_module] *)

(* ****** ****** *)
//
static
fun device_open_ (inode_ptr1, file_ptr1): interr = "mac#"
static
fun device_release_ (inode_ptr1, file_ptr1): interr = "mac#"
//
(* ****** ****** *)

implement
device_open_
  (inx, filp) = let
in
//
if
(Device_open = 0)
then let
//
extvar
"Device_open" = Device_open + 1
extvar
"Device_open_count" = Device_open_count + 1
//
val () =
$extfcall
(
  void
, "sprintf"
, Message0_ptr, "Hello(%d) from the chardev\n", Device_open_count
) : void // end of [val]
//
extvar
"Message1_ptr" = Message0_ptr
//
in
  0(*SUCCESS*)
end // end of [then]
else ~(EBUSY) // end of [else]
//
end // end of [device_open_]

(* ****** ****** *)

implement
device_release_
  (inx, filp) = let
//
extvar
"Device_open" = Device_open - 1
//
in
  0(*SUCCESS*)
end // end of [device_release_]

(* ****** ****** *)

%{$
//
static
inline
int
device_open
(
struct inode *p0, struct file *p1
) { return device_open_(p0, p1) ; }
//
static
inline
int
device_release
(
struct inode *p0, struct file *p1
) { return device_release_(p0, p1) ; }
//
%} // end of [%{$]

(* ****** ****** *)
//
static
fun
device_read_{n:int}
(
  file_ptr1, buf: &ubytes(n), size_t(n), ofs: &loff_t
) : ssize_t = "mac#" // end-of-function
static
fun
device_write_{n:int}
(
  file_ptr1, buf: &ubytes(n), size_t(n), ofs: &loff_t
) : ssize_t = "mac#" // end-of-function
//
(* ****** ****** *)

implement
device_read_
  (filp, buf, n, ofs) = let
//
val n2 =
string_nlength<>
  ($UN.cast{string}(Message1_ptr), n)
//
val
nread =
$extfcall
(
  size_t
, "copy_to_user", addr@buf, Message1_ptr, n2
) (* end of [val] *)
//
extvar
"Message1_ptr" =
add_ptr_bsz ($UN.cast{ptr}(Message1_ptr), nread)
//
val () =
$extfcall
(
  void, "printk", KERN_INFO_"device_read_: n2 = %ld", n2
)
val () =
$extfcall
(
  void, "printk", KERN_INFO_"device_read_: nread = %ld", nread
)
//
in
  $UN.cast{ssize_t}(nread)
end // end of [device_read_]

(* ****** ****** *)

implement
device_write_
  (filp, buf, n, ofs) = let
//
val () =
$extfcall
(
  void
, "printk"
, KERN_ALERT_"Sorry, this operation isn't supported.\n"
) (* end of [val] *)
//
in
  $UN.cast{ssize_t}(~(EINVAL))
end // end of [device_write_]

(* ****** ****** *)

%{$
//
static
inline
ssize_t
device_read
(
struct file *p0, char *buf, size_t n, loff_t *ofs
) { return device_read_(p0, buf, n, ofs) ; }
//
static
inline
ssize_t
device_write
(
struct file *p0, const char *buf, size_t n, loff_t *ofs
) { return device_write_(p0, (void*)buf, n, ofs) ; }
//
%} // end of [%{$]

(* ****** ****** *)

(* end of [chardev-1.dats] *)

(*
** A simple char device
*)

(* ****** ****** *)
//
// HX-2014-10-24:
// nothing fancy here;
// just trying to get it working
//
(* ****** ****** *)
//
// HX-2014-10-21:
// no use for dynloading
//
#define ATS_DYNLOADFLAG 0
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
#include
"{$KERNELATS}/prelude/staloadall.hats"
//
(* ****** ****** *)
//
staload
"{$LINUX}/basics.sats"
//
(* ****** ****** *)
//
staload
"{$LINUX}/SATS/errno.sats"
staload
"{$LINUX}/SATS/types.sats"
//
(* ****** ****** *)
//
staload
"{$LINUX}/SATS/init.sats"
staload
"{$LINUX}/SATS/module.sats"
staload
"{$LINUX}/SATS/kernel.sats"
staload $PRINTK // HX: opening NS
//
staload "{$LINUX}/SATS/fs.sats"
//
staload "{$LINUX}/SATS/asm/uaccess.sats"
//
(* ****** ****** *)

staload
UN = "prelude/SATS/unsafe.sats"

(* ****** ****** *)

%{^
MODULE_LICENSE("Dual BSD/GPL") ;
%} // end of [%{^]

(* ****** ****** *)

static
fun init_module(): interr = "mac#"
static
fun cleanup_module(): void = "mac#"

(* ****** ****** *)

%{^
static int Major = 0;
static int Device_open = 0;
static int Device_open_count = 0;
%} // end of [%{^]

macdef
Major = $extval(int, "Major")
macdef
Device_open = $extval(int, "Device_open")
macdef
Device_open_count = $extval(int, "Device_open_count")

(* ****** ****** *)

%{^
#define BUFLEN 80 // Max length of the message from the device
#define DEVICE_NAME "chardev-1" /* Dev name as it appears in /proc/devices */
//
typedef
char *charptr ;
char Message[BUFLEN];
charptr Message0_ptr = &Message[0];
charptr Message1_ptr = &Message[0];
//
%} // end of [%{^]

typedef charptr = $extype"charptr"

macdef
DEVICE_NAME = $extval(string, "DEVICE_NAME")
macdef
Message0_ptr = $extval(charptr, "Message0_ptr")
macdef
Message1_ptr = $extval(charptr, "Message1_ptr")

(* ****** ****** *)

%{^
//
static int device_open(struct inode *, struct file *);
static int device_release(struct inode *, struct file *);
static ssize_t device_read(struct file *, char *, size_t, loff_t *);
static ssize_t device_write(struct file *, const char *, size_t, loff_t *);
//
%} // end of [%{^]

(* ****** ****** *)

%{^

struct
file_operations
fops = {
  .read = device_read,
  .write = device_write,
  .open = device_open,
  .release = device_release
} ;

static void *fops_ptr = &(fops);

%} // end of [%{^]

macdef
fops_ptr = $extval(fops_ptr1, "fops_ptr")

(* ****** ****** *)

implement
init_module
(
) = let
//
extvar
"Major" =
register_chrdev(0u, DEVICE_NAME, fops_ptr)
//
val Major = g1ofg0(Major)
//
in
//
if
(Major > 0)
then let
//
val () =
$extfcall
(
  void
, "printk", KERN_INFO_"The assigned major number is: %d\n", Major
) (* end of [val] *)
//
in
  0(*SUCCESS*)
end // end of [then]
else let
//
val () =
$extfcall
(
  void
, "printk", KERN_ALERT_"Registering chardev failed with %d\n", Major
) (* end of [val] *)
//
in
  Major
end // end of [else]
//
end (* end of [init_module] *)

(* ****** ****** *)

implement
cleanup_module
(
// argumentless
) = () where
{
//
val
Major =
(
if Major > 0
  then g0i2u(Major) else 0u
// end of [if]
) : uint // end of [val]
//
val () = unregister_chrdev(Major, DEVICE_NAME)
//
} (* end of [cleanup_module] *)

(* ****** ****** *)
//
static
fun device_open_ (inode_ptr1, file_ptr1): interr = "mac#"
static
fun device_release_ (inode_ptr1, file_ptr1): interr = "mac#"
//
(* ****** ****** *)

implement
device_open_
  (inx, filp) = let
in
//
if
(Device_open = 0)
then let
//
extvar
"Device_open" = Device_open + 1
extvar
"Device_open_count" = Device_open_count + 1
//
val () =
$extfcall
(
  void
, "sprintf"
, Message0_ptr, "Hello(%d) from the chardev\n", Device_open_count
) : void // end of [val]
//
extvar
"Message1_ptr" = Message0_ptr
//
in
  0(*SUCCESS*)
end // end of [then]
else ~(EBUSY) // end of [else]
//
end // end of [device_open_]

(* ****** ****** *)

implement
device_release_
  (inx, filp) = let
//
extvar
"Device_open" = Device_open - 1
//
in
  0(*SUCCESS*)
end // end of [device_release_]

(* ****** ****** *)

%{$
//
static
inline
int
device_open
(
struct inode *p0, struct file *p1
) { return device_open_(p0, p1) ; }
//
static
inline
int
device_release
(
struct inode *p0, struct file *p1
) { return device_release_(p0, p1) ; }
//
%} // end of [%{$]

(* ****** ****** *)
//
static
fun
device_read_{n:int}
(
  file_ptr1, buf: &ubytes(n), size_t(n), ofs: &loff_t
) : ssize_t = "mac#" // end-of-function
static
fun
device_write_{n:int}
(
  file_ptr1, buf: &ubytes(n), size_t(n), ofs: &loff_t
) : ssize_t = "mac#" // end-of-function
//
(* ****** ****** *)

implement
device_read_
  (filp, buf, n, ofs) = let
//
val n2 =
string_nlength<>
  ($UN.cast{string}(Message1_ptr), n)
//
val
nread =
$extfcall
(
  size_t
, "copy_to_user", addr@buf, Message1_ptr, n2
) (* end of [val] *)
//
extvar
"Message1_ptr" =
add_ptr_bsz ($UN.cast{ptr}(Message1_ptr), nread)
//
val () =
$extfcall
(
  void, "printk", "device_read_: n2 = %ld", n2
)
val () =
$extfcall
(
  void, "printk", "device_read_: nread = %ld", nread
)
//
in
  $UN.cast{ssize_t}(nread)
end // end of [device_read_]

(* ****** ****** *)

implement
device_write_
  (filp, buf, n, ofs) = let
//
val () =
$extfcall
(
  void
, "printk"
, KERN_ALERT_"Sorry, this operation isn't supported.\n"
) (* end of [val] *)
//
in
  $UN.cast{ssize_t}(~(EINVAL))
end // end of [device_write_]

(* ****** ****** *)

%{$
//
static
inline
ssize_t
device_read
(
struct file *p0, char *buf, size_t n, loff_t *ofs
) { return device_read_(p0, buf, n, ofs) ; }
//
static
inline
ssize_t
device_write
(
struct file *p0, const char *buf, size_t n, loff_t *ofs
) { return device_write_(p0, (void*)buf, n, ofs) ; }
//
%} // end of [%{$]

(* ****** ****** *)

(* end of [chardev-1.dats] *)


Updating: very very minorly

Updating: very very minorly

(*
** THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
** EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
** OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
** NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
** HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
** WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
** FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
** OTHER DEALINGS IN THE SOFTWARE.
*)

(* ****** ****** *)

(*
** A library of grading for my own use
*)

(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTcom
// Start time: the first of July, 2016
//
(* ****** ****** *)
//
#define
MYGRADING_HATS 1
//
(* ****** ****** *)
//
extern
fun
csv_parse_line
(
  line: string
) : List0_vt(Strptr1)
//
(* ****** ****** *)
//
extern
fun
csv_parse_line_nerr
(
  line: string, nerr: &int >> _
) : List0_vt(Strptr1)
//
(* ****** ****** *)

implement
csv_parse_line
  (line) = res0 where
{
//
var nerr: int = 0
val res0 = csv_parse_line_nerr(line, nerr)
//
} (* end of [csv_parse_line] *)

(* ****** ****** *)
//
local
//
#include "./csv_parse_line.hats"
//
in (* nothing *) end // [local]
//
(* ****** ****** *)

(* end of [mygrading.hats] *)

(*
** THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
** EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
** OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
** NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
** HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
** WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
** FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
** OTHER DEALINGS IN THE SOFTWARE.
*)

(* ****** ****** *)

(*
** A library of grading for my own use
*)

(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTcom
// Start time: the first of July, 2016
//
(* ****** ****** *)
//
#define
MYGRADING_HATS 1
//
(* ****** ****** *)
//
extern
fun
csv_parse_line
(
  line: string
) : List0_vt(Strptr1)
//
(* ****** ****** *)
//
extern
fun
csv_parse_line_nerr
(
  line: string, nerr: &int >> _
) : List0_vt(Strptr1)
//
(* ****** ****** *)

implement
csv_parse_line
  (line) = let
//
var nerr: int = 0
val res0 = csv_parse_line_nerr(line, nerr)
//
in
  res0
end // end of [csv_parse_line]

(* ****** ****** *)
//
local
//
#include "./csv_parse_line.hats"
//
in (* nothing *) end // [local]
//
(* ****** ****** *)

(* end of [mygrading.hats] *)


Updating: very minorly tidying-up

Updating: very minorly tidying-up

(*
** For writing ATS code
** that translates into JavaScript
*)

(* ****** ****** *)

(*
** Permission to use, copy, modify, and distribute this software for any
** purpose with or without fee is hereby granted, provided that the above
** copyright notice and this permission notice appear in all copies.
**
** THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
** WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
** MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
** ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
** WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
** ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
** OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)

(* ****** ****** *)

(*
** Author: Hongwei Xi
** Authoremail: gmhwxi AT gmail DOT com
** Start Time: April, 2015
*)

(* ****** ****** *)

#define
ATS_STALOADFLAG 0 // no staloading at run-time
#define
ATS_EXTERN_PREFIX "ats2js_bacon_" // prefix for external names

(* ****** ****** *)
//
staload
"./../../basics_js.sats"
//
(* ****** ****** *)
//
abstype Event = ptr
abstype EStream(a:t@ype) = ptr
//
abstype Property(a:t@ype) = ptr
//
(* ****** ****** *)
//
fun
Bacon_once
  {a:t0p}(x: a): EStream(a) = "mac#%"
fun
Bacon_never
  {a:t0p}((*void*)): EStream(a) = "mac#%"
//
(* ****** ****** *)
//
fun
Bacon_delay
  {a:t0p}
  (ms: intGte(0), x: a): EStream(a) = "mac#%"
//
(* ****** ****** *)
//
fun
Bacon_interval
  {a:t0p}
  (ms: intGte(0), x: a): EStream(a) = "mac#%"
//
fun
Bacon_repeatedly
  {a:t0p}
  (ms: intGte(0), xs: JSarray(a)): EStream(a) = "mac#%"
//
fun
Bacon_sequentially
  {a:t0p}
  (ms: intGte(0), xs: JSarray(a)): EStream(a) = "mac#%"
//
(* ****** ****** *)
//
fun
Bacon_repeat{a:t0p}
(
  fopr: cfun(intGte(0), EStream(a))
) : EStream(a) = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun
EStream_map
  {a,b:t0p}
(
  xs: EStream(a), fopr: cfun(a, b)
) : EStream(b) = "mac#%" // end-of-fun
fun
Property_map
  {a,b:t0p}
(
  xs: Property(a), fopr: cfun(a, b)
) : Property(b) = "mac#%" // end-of-fun
//
overload map with EStream_map
overload map with Property_map
overload .map with EStream_map
overload .map with Property_map
//
(* ****** ****** *)
//
fun
EStream_map_property
  {a,b:t0p}
(
  xs: EStream(a), ys: Property(b)
) : EStream(b) = "mac#%" // end-of-fun
//
overload map with EStream_map_property
overload .map with EStream_map_property
//
(* ****** ****** *)
//
fun
EStream_filter
  {a:t0p}
(
  xs: EStream(a), test: cfun(a, bool)
) : EStream(a) = "mac#%" // end-of-fun
//
overload filter with EStream_filter
overload .filter with EStream_filter
//
(* ****** ****** *)
//
fun
EStream_filter_property
  {a:t0p}
(
  xs: EStream(a), bs: Property(bool)
) : EStream(a) = "mac#%" // end-of-fun
//
overload filter with EStream_filter_property
overload .filter with EStream_filter_property
//
(* ****** ****** *)
//
fun
EStream_scan
  {a,b:t0p}
(
  xs: EStream(b), ini: a, fopr: cfun(a, b, a)
) : Property(a) = "mac#%" // end-of-function
//
overload scan with EStream_scan
overload .scan with EStream_scan
//
(* ****** ****** *)
//
fun
EStream_merge2
  {a:t0p}
  (EStream(a), EStream(a)): EStream(a) = "mac#%"
fun
EStream_merge3
  {a:t0p}
  (EStream(a), EStream(a), EStream(a)): EStream(a) = "mac#%"
//
overload merge with EStream_merge2
overload merge with EStream_merge3
//
overload .merge with EStream_merge2
overload .merge with EStream_merge3
//
(* ****** ****** *)
//
fun
Bacon_combineWith2
  {a,b,c:t0p}
(
  Property(a), Property(b), cfun(a, b, c)
) : Property(c) = "mac#%" // end-of-function
fun
Bacon_combineWith3
  {a,b,c,d:t0p}
(
  Property(a), Property(b), Property(c), cfun(a, b, c, d)
) : Property(d) = "mac#%" // end-of-function
//
overload combineWith with Bacon_combineWith2
overload combineWith with Bacon_combineWith3
//
(* ****** ****** *)
//
fun
EStream_toProperty
  {a:t0p}(EStream(a)): Property(a) = "mac#%"
fun
EStream_toProperty_init
  {a:t0p}(EStream(a), x0: a): Property(a) = "mac#%"
//
overload toProperty with EStream_toProperty
overload toProperty with EStream_toProperty_init
overload .toProperty with EStream_toProperty
overload .toProperty with EStream_toProperty_init
//
fun
Property_toEventStream
  {a:t0p}(Property(a)): EStream(a) = "mac#%"
//
overload toEventStream with Property_toEventStream
overload .toEventStream with Property_toEventStream
//
(* ****** ****** *)
//
fun
EStream_onValue
  {a:t0p}(EStream(a), cfun(a, void)): void = "mac#%"
fun
Property_onValue
  {a:t0p}(Property(a), cfun(a, void)): void = "mac#%"
//
overload onValue with EStream_onValue
overload onValue with Property_onValue
overload .onValue with EStream_onValue
overload .onValue with Property_onValue
//
(* ****** ****** *)
//
fun
EStream_subscribe
  {a:t0p}(EStream(a), cfun(Event, void)): void = "mac#%"
fun
Property_subscribe
  {a:t0p}(Property(a), cfun(Event, void)): void = "mac#%"
//
overload subscribe with EStream_subscribe
overload subscribe with Property_subscribe
overload .subscribe with EStream_subscribe
overload .subscribe with Property_subscribe
//
(* ****** ****** *)
//
fun
Property_startWith
  {a:t0p}(Property(a), a): Property(a) = "mac#%"
//
(* ****** ****** *)
//
fun
EStream_doAction
  {a:t0p}
  (xs: EStream(a), f: cfun(a, void)): EStream(a) = "mac#%"
fun
Property_doAction
  {a:t0p}
  (xs: Property(a), f: cfun(a, void)): Property(a) = "mac#%"
//
overload doAction with EStream_doAction
overload doAction with Property_doAction
overload .doAction with EStream_doAction
overload .doAction with Property_doAction
//
(* ****** ****** *)
//
fun
Property_sampledBy_estream
  {a,b:t0p}(Property(a), EStream(b)): EStream(a) = "mac#%"
fun
Property_sampledBy_property
  {a,b:t0p}(Property(a), Property(b)): Property(a) = "mac#%"
//
overload sampledBy with Property_sampledBy_estream
overload sampledBy with Property_sampledBy_property
overload .sampledBy with Property_sampledBy_estream
overload .sampledBy with Property_sampledBy_property
//
(* ****** ****** *)
//
fun
Property_sampledBy_estream_cfun
  {a,b:t0p}{c:t0p}
(
  Property(a), EStream(b), cfun(a, b, c)
) : EStream(c) = "mac#%" // end-of-function
fun
Property_sampledBy_property_cfun
  {a,b:t0p}{c:t0p}
(
  Property(a), Property(b), cfun(a, b, c)
) : Property(c) = "mac#%" // end-of-function
//
overload sampledBy with Property_sampledBy_estream_cfun
overload sampledBy with Property_sampledBy_property_cfun
overload .sampledBy with Property_sampledBy_estream_cfun
overload .sampledBy with Property_sampledBy_property_cfun
//
(* ****** ****** *)
//
fun
EStream_zip_estream_cfun
  {a,b:t0p}{c:t0p}
(
  xs: EStream(a), ys: EStream(b), cfun(a, b, c)
) : EStream(c) = "mac#%" // end-of-function
//
overload zip with EStream_zip_estream_cfun
overload .zip with EStream_zip_estream_cfun
//
(* ****** ****** *)

(* end of [baconjs.sats] *)

(*
** For writing ATS code
** that translates into JavaScript
*)

(* ****** ****** *)

(*
** Permission to use, copy, modify, and distribute this software for any
** purpose with or without fee is hereby granted, provided that the above
** copyright notice and this permission notice appear in all copies.
**
** THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
** WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
** MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
** ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
** WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
** ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
** OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)

(* ****** ****** *)

(*
** Author: Hongwei Xi
** Authoremail: gmhwxi AT gmail DOT com
** Start Time: April, 2015
*)

(* ****** ****** *)

#define
ATS_STALOADFLAG 0 // no staloading at run-time
#define
ATS_EXTERN_PREFIX "ats2js_bacon_" // prefix for external names

(* ****** ****** *)
//
staload
"./../../basics_js.sats"
//
(* ****** ****** *)
//
abstype Event = ptr
abstype EStream(a:t@ype) = ptr
//
abstype Property(a:t@ype) = ptr
//
(* ****** ****** *)
//
fun
Bacon_once
  {a:t0p}(x: a): EStream(a) = "mac#%"
fun
Bacon_never
  {a:t0p}((*void*)): EStream(a) = "mac#%"
//
(* ****** ****** *)
//
fun
Bacon_delay
  {a:t0p}
  (delay: intGte(0), x: a): EStream(a) = "mac#%"
//
(* ****** ****** *)
//
fun
Bacon_interval
  {a:t0p}(int: intGte(0), x: a): EStream(a) = "mac#%"
//
fun
Bacon_repeatedly
  {a:t0p}
  (int: intGte(0), xs: JSarray(a)): EStream(a) = "mac#%"
//
fun
Bacon_sequentially
  {a:t0p}
  (int: intGte(0), xs: JSarray(a)): EStream(a) = "mac#%"
//
(* ****** ****** *)
//
fun
Bacon_repeat{a:t0p}
  (fopr: cfun(intGte(0), EStream(a))): EStream(a) = "mac#%"
//
(* ****** ****** *)
//
fun
EStream_map
  {a,b:t0p}
(
  xs: EStream(a), fopr: cfun(a, b)
) : EStream(b) = "mac#%" // end-of-fun
fun
Property_map
  {a,b:t0p}
(
  xs: Property(a), fopr: cfun(a, b)
) : Property(b) = "mac#%" // end-of-fun
//
overload map with EStream_map
overload map with Property_map
overload .map with EStream_map
overload .map with Property_map
//
(* ****** ****** *)
//
fun
EStream_map_property
  {a,b:t0p}
(
  xs: EStream(a), ys: Property(b)
) : EStream(b) = "mac#%" // end-of-fun
//
overload map with EStream_map_property
overload .map with EStream_map_property
//
(* ****** ****** *)
//
fun
EStream_filter
  {a:t0p}
(
  xs: EStream(a), test: cfun(a, bool)
) : EStream(a) = "mac#%" // end-of-fun
//
overload filter with EStream_filter
overload .filter with EStream_filter
//
(* ****** ****** *)
//
fun
EStream_filter_property
  {a:t0p}
(
  xs: EStream(a), bs: Property(bool)
) : EStream(a) = "mac#%" // end-of-fun
//
overload filter with EStream_filter_property
overload .filter with EStream_filter_property
//
(* ****** ****** *)
//
fun
EStream_scan
  {a,b:t0p}
(
  xs: EStream(b), ini: a, fopr: cfun(a, b, a)
) : Property(a) = "mac#%" // end-of-function
//
overload scan with EStream_scan
overload .scan with EStream_scan
//
(* ****** ****** *)
//
fun
EStream_merge2
  {a:t0p}
  (EStream(a), EStream(a)): EStream(a) = "mac#%"
fun
EStream_merge3
  {a:t0p}
  (EStream(a), EStream(a), EStream(a)): EStream(a) = "mac#%"
//
overload merge with EStream_merge2
overload merge with EStream_merge3
//
overload .merge with EStream_merge2
overload .merge with EStream_merge3
//
(* ****** ****** *)
//
fun
Bacon_combineWith2
  {a,b,c:t0p}
(
  Property(a), Property(b), cfun(a, b, c)
) : Property(c) = "mac#%" // end-of-function
fun
Bacon_combineWith3
  {a,b,c,d:t0p}
(
  Property(a), Property(b), Property(c), cfun(a, b, c, d)
) : Property(d) = "mac#%" // end-of-function
//
overload combineWith with Bacon_combineWith2
overload combineWith with Bacon_combineWith3
//
(* ****** ****** *)
//
fun
EStream_toProperty
  {a:t0p}(EStream(a)): Property(a) = "mac#%"
fun
EStream_toProperty_init
  {a:t0p}(EStream(a), x0: a): Property(a) = "mac#%"
//
overload toProperty with EStream_toProperty
overload toProperty with EStream_toProperty_init
overload .toProperty with EStream_toProperty
overload .toProperty with EStream_toProperty_init
//
fun
Property_toEventStream
  {a:t0p}(Property(a)): EStream(a) = "mac#%"
//
overload toEventStream with Property_toEventStream
overload .toEventStream with Property_toEventStream
//
(* ****** ****** *)
//
fun
EStream_onValue
  {a:t0p}(EStream(a), cfun(a, void)): void = "mac#%"
fun
Property_onValue
  {a:t0p}(Property(a), cfun(a, void)): void = "mac#%"
//
overload onValue with EStream_onValue
overload onValue with Property_onValue
overload .onValue with EStream_onValue
overload .onValue with Property_onValue
//
(* ****** ****** *)
//
fun
EStream_subscribe
  {a:t0p}(EStream(a), cfun(Event, void)): void = "mac#%"
fun
Property_subscribe
  {a:t0p}(Property(a), cfun(Event, void)): void = "mac#%"
//
overload subscribe with EStream_subscribe
overload subscribe with Property_subscribe
overload .subscribe with EStream_subscribe
overload .subscribe with Property_subscribe
//
(* ****** ****** *)
//
fun
Property_startWith
  {a:t0p}(Property(a), a): Property(a) = "mac#%"
//
(* ****** ****** *)
//
fun
EStream_doAction
  {a:t0p}
  (xs: EStream(a), f: cfun(a, void)): EStream(a) = "mac#%"
fun
Property_doAction
  {a:t0p}
  (xs: Property(a), f: cfun(a, void)): Property(a) = "mac#%"
//
overload doAction with EStream_doAction
overload doAction with Property_doAction
overload .doAction with EStream_doAction
overload .doAction with Property_doAction
//
(* ****** ****** *)
//
fun
Property_sampledBy_estream
  {a,b:t0p}(Property(a), EStream(b)): EStream(a) = "mac#%"
fun
Property_sampledBy_property
  {a,b:t0p}(Property(a), Property(b)): Property(a) = "mac#%"
//
overload sampledBy with Property_sampledBy_estream
overload sampledBy with Property_sampledBy_property
overload .sampledBy with Property_sampledBy_estream
overload .sampledBy with Property_sampledBy_property
//
(* ****** ****** *)
//
fun
Property_sampledBy_estream_cfun
  {a,b:t0p}{c:t0p}
(
  Property(a), EStream(b), cfun(a, b, c)
) : EStream(c) = "mac#%" // end-of-function
fun
Property_sampledBy_property_cfun
  {a,b:t0p}{c:t0p}
(
  Property(a), Property(b), cfun(a, b, c)
) : Property(c) = "mac#%" // end-of-function
//
overload sampledBy with Property_sampledBy_estream_cfun
overload sampledBy with Property_sampledBy_property_cfun
overload .sampledBy with Property_sampledBy_estream_cfun
overload .sampledBy with Property_sampledBy_property_cfun
//
(* ****** ****** *)
//
fun
EStream_zip_estream_cfun
  {a,b:t0p}{c:t0p}
(
  xs: EStream(a), ys: EStream(b), cfun(a, b, c)
) : EStream(c) = "mac#%" // end-of-function
//
overload zip with EStream_zip_estream_cfun
overload .zip with EStream_zip_estream_cfun
//
(* ****** ****** *)

(* end of [baconjs.sats] *)