Updating: very minorly improving

Updating: very minorly improving

(*
** Bit-strings
*)

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

%{^
//
#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 CHAN0 =
"./../DATS/basis_channel0.dats"
staload CHAN1 =
"./../DATS/basis_channel1.dats"
//
(* ****** ****** *)
//
staload _ =
"./../DATS/basis_ssntype2r.dats"
//
(* ****** ****** *)
//
abstype
ssn_list(a:vt@ype)
//
(* ****** ****** *)
//
datatype
chan1neg_list
  (a:vt@ype, type) =
| chan1neg_list_nil(a, nil) of ()
| chan1neg_list_cons
    (a, snd(a) :: ssn_list(a)) of ()
  // chan1neg_list_cons
//
(* ****** ****** *)
//
extern
fun{}
chan1neg_list
  {a:vt@ype}
(
  chneg:
  !chan1neg(ssn_list(a)) >> chan1neg(ss)
) : #[ss:type] chan1neg_list(a, ss)
//
(* ****** ****** *)
//
extern
fun{}
chan1pos_list_nil
  {a:vt@ype}
(
  chpos:
  !chan1pos(ssn_list(a)) >> chan1pos(nil)
) : void // end of [chan1pos_list_nil]
extern
fun{}
chan1pos_list_cons
  {a:vt@ype}
(
  chpos:
  !chan1pos(ssn_list(a)) >> chan1pos(snd(a)::ssn_list(a))
) : void // end of [chan1pos_list_cons]
//
(* ****** ****** *)

implement
{}(*tmp*)
chan1pos_list_nil
  (chpos) = () where
{
//
vtypedef
chan0 = $CHAN0.channel0(ptr, 2)
//
val
chan0 = $UN.castvwtp1{chan0}(chpos)
//
val () =
$CHAN0.channel0_send(chan0, 0, 1, $UN.int2ptr(0))
//
prval () = $UN.cast2void(chan0)
prval () = $UN.castview2void(chpos)
//
} (* end of [chan1pos_list_nil] *)
//
(* ****** ****** *)

implement
{}(*tmp*)
chan1pos_list_cons
  (chpos) = () where
{
//
vtypedef
chan0 = $CHAN0.channel0(ptr, 2)
//
val
chan0 = $UN.castvwtp1{chan0}(chpos)
//
val () =
$CHAN0.channel0_send(chan0, 0, 1, $UN.int2ptr(1))
//
prval () = $UN.cast2void(chan0)
prval () = $UN.castview2void(chpos)
//
} (* end of [chan1pos_list_cons] *)

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

implement
{}(*tmp*)
chan1neg_list
  (chneg) = let
//
vtypedef
chan0 = $CHAN0.channel0(ptr, 2)
val
chan0 = $UN.castvwtp1{chan0}(chneg)
//
val tag =
  $CHAN0.channel0_recv_val(chan0, 0, 1)
//
prval () = $UN.cast2void(chan0)
//
in
//
if
iseqz(tag)
then let
  prval () = $UN.castview2void(chneg) in chan1neg_list_nil()
end // end of [then]
else let
  prval () = $UN.castview2void(chneg) in chan1neg_list_cons()
end // end of [else]
//
end // end of [chan1neg_list]

(* ****** ****** *)
//
abst@ype bit = int
//
macdef B0 = $UN.cast{bit}(0)
macdef B1 = $UN.cast{bit}(1)
//
typedef bit_ = natLt(2)
//
extern castfn bit2bit_(bit): bit_
//
(* ****** ****** *)
//
extern
fun
int2bits
  {n:nat}(int(n)): chan1neg(ssn_list(bit))
//
(* ****** ****** *)

implement
int2bits(n) = let
//
fun
fserv{n:nat}
(
  n: int(n), chp: chan1pos(ssn_list(bit))
) : void = (
//
if
n > 0
then let
  val n2 = half(n)
  val bit =
  (
    if n = 2*n2 then B0 else B1
  ) : bit // end of [val]
  val () = chan1pos_list_cons(chp)
  val ((*void*)) = chan1pos_send<bit>(chp, bit)
in
  fserv(n2, chp)
end // end of [then]
else let
  val () = chan1pos_list_nil(chp) in channel1_close(chp)
end // end of [else]
//
) (* end of [fserv] *)
//
in
  chan1neg_create_exn{ssn_list(bit)}(llam(chp) => fserv(n, chp))
end // end of [int2bits]

(* ****** ****** *)
//
extern
fun
succ_bits
(
  chneg:
  chan1neg(ssn_list(bit))
) : chan1neg(ssn_list(bit))
//
(* ****** ****** *)

implement
succ_bits(chn) = let
//
fun
fserv
(
  chp: chan1pos(ssn_list(bit))
, chn: chan1neg(ssn_list(bit))
) : void = let
//
val opt = chan1neg_list(chn)
//
in
//
case+ opt of
| chan1neg_list_nil() => let
    val () =
      chan1pos_list_cons(chp)
    val () =
      chan1pos_send<bit>(chp, B1)
    val () =
      chan1pos_list_nil(chp)
    // end of [val]
    val () = channel1_close(chp)
    val () = channel1_close(chn)
  in
    // nothing
  end // end of [chan1neg_list_nil]
| chan1neg_list_cons() => let
    val () =
      chan1pos_list_cons (chp)
    val bit = chan1neg_send_val<bit> (chn)
    val bit_ = bit2bit_(bit)
  in
    if bit_ > 0
      then let
        val () =
          chan1pos_send (chp, B0)
        // end of [val]
      in
        fserv(chp, chn)
      end // end of [then]
      else let
        val () =
          chan1pos_send (chp, B1)
        // end of [val]
      in
        chan1posneg_elim(chp, chn)
      end // end of [else]
  end // end of [chan1neg_list_cons]
//
end // end of [fserv]
//
in
  chan1neg_create_exn{ssn_list(bit)}(llam(chp) => fserv(chp, chn))
end // end of [succ_bits]

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

extern
fun
add_bits_bits
(
  chan1neg(ssn_list(bit))
, chan1neg(ssn_list(bit))
) : chan1neg(ssn_list(bit))

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

implement
add_bits_bits
  (chn1, chn2) = let
//
fun
fserv
(
  chp: chan1pos(ssn_list(bit))
, chn1: chan1neg(ssn_list(bit))
, chn2: chan1neg(ssn_list(bit))
) : void = let
//
val opt1 = chan1neg_list (chn1)
//
in
//
case+ opt1 of
| chan1neg_list_nil() => let
    val () = channel1_close(chn1)
  in
    chan1posneg_elim (chp, chn2)
  end // end of [chan1neg_list_nil]
| chan1neg_list_cons() => let
    val () =
      chan1pos_list_cons (chp)
    // end of [val]
    val opt2 = chan1neg_list (chn2)
  in
    case+ opt2 of
    | chan1neg_list_nil() => let
        val () =
          channel1_close(chn2)
        // end of [val]
      in
        chan1posneg_elim(chp, chn1)
      end // end of [chan1neg_list_nil]
    | chan1neg_list_cons() => let
        val b1 = chan1neg_send_val(chn1)
        and b2 = chan1neg_send_val(chn2)
        val b1_ = bit2bit_(b1) and b2_ = bit2bit_(b2)
      in
        case+ b1_ of
        | 0 => (
            chan1pos_send(chp, b2); fserv(chp, chn1, chn2)
          ) (* end of [0] *)
        | 1 => (
            case+ b2_ of
            | 0 => (chan1pos_send(chp, B1); fserv(chp, chn1, chn2))
            | 1 => (chan1pos_send(chp, B0); fserv(chp, chn1, succ_bits(chn2)))
          ) (* end of [1] *)
      end // end of [chan1neg_list_cons]
  end // end of [chan1neg_list_cons]
//
end // end of [fserv]
//
in
  chan1neg_create_exn{ssn_list(bit)}(llam(chp) => fserv(chp, chn1, chn2))
end // end of [add_bits_bits]

(* ****** ****** *)
//
extern
fun
bits2int
(
  chn: chan1neg(ssn_list(bit))
) : intGte(0) // end-of-function
//
(* ****** ****** *)

implement
bits2int(chn) = let
//
fun
loop
(
  xs: List0_vt(bit), res: intGte(0)
) : intGte(0) =
(
case+ xs of
| ~list_vt_nil() => res
| ~list_vt_cons(x, xs) =>
    loop (xs, 2*res + bit2bit_(x))
) (* end of [loop] *)
//
//
fun
loop2
(
  chn: chan1neg(ssn_list(bit)), xs: List0_vt(bit)
) : List0_vt(bit) = let
//
val opt = chan1neg_list(chn)
//
in
//
case+ opt of
| chan1neg_list_nil() => let
    val () =
      channel1_close(chn) in xs
    // end of [val]
  end // end of [chan1neg_list_nil]
| chan1neg_list_cons() => let
    val x =
      chan1neg_send_val<bit> (chn)
    // end of [val]
  in
    loop2(chn, list_vt_cons(x, xs))
  end // end of [chan1neg_list_cons]
//
end // end of [loop2]
//
in
  loop(loop2(chn, list_vt_nil(*void*)), 0)
end // end of [bits2int]

(* ****** ****** *)
//
extern
fun
succ_int(intGte(0)): intGte(0)
//
(* ****** ****** *)
//
implement
succ_int(x) =
  bits2int(succ_bits(int2bits(x)))
//
(* ****** ****** *)
//
extern
fun
add_int_int(intGte(0), intGte(0)): intGte(0)
//
(* ****** ****** *)
//
implement
add_int_int(x, y) =
  bits2int(add_bits_bits(int2bits(x), int2bits(y)))
//
(* ****** ****** *)

implement
main0(argc, argv) =
{
//
val a0 =
(
if argc >= 2
  then g0string2int(argv[1]) else 0
// end of [if]
) : int // end of [val]
//
val a1 =
(
if argc >= 3
  then g0string2int(argv[2]) else 0
// end of [if]
) : int // end of [val]
//
val a0 = g1ofg0(a0)
and a1 = g1ofg0(a1)
//
val () = assertloc (a0 >= 0)
val () = assertloc (a1 >= 0)
//
val () =
println!
  (a0, " + ", a1, " = ", add_int_int(a0, a1))
//
val _(*left*) = $UNISTD.usleep(250000u)
//
} (* end of [main0] *)

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

(* end of [bitstr.dats] *)

(*
** Bit-strings
*)

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

%{^
//
#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 CHAN0 =
"./../DATS/basis_channel0.dats"
staload CHAN1 =
"./../DATS/basis_channel1.dats"
//
(* ****** ****** *)
//
staload _ =
"./../DATS/basis_ssntype2r.dats"
//
(* ****** ****** *)
//
abstype
ssn_list(a:vt@ype)
//
(* ****** ****** *)
//
datatype
chan1neg_list
  (a:vt@ype, type) =
| chan1neg_list_nil(a, nil) of ()
| chan1neg_list_cons
    (a, snd(a) :: ssn_list(a)) of ()
  // chan1neg_list_cons
//
(* ****** ****** *)
//
extern
fun{}
chan1neg_list
  {a:vt@ype}
(
  chneg:
  !chan1neg(ssn_list(a)) >> chan1neg(ss)
) : #[ss:type] chan1neg_list(a, ss)
//
(* ****** ****** *)
//
extern
fun{}
chan1pos_list_nil
  {a:vt@ype}
(
  chpos:
  !chan1pos(ssn_list(a)) >> chan1pos(nil)
) : void // end of [chan1pos_list_nil]
extern
fun{}
chan1pos_list_cons
  {a:vt@ype}
(
  chpos:
  !chan1pos(ssn_list(a)) >> chan1pos(snd(a)::ssn_list(a))
) : void // end of [chan1pos_list_cons]
//
(* ****** ****** *)

implement
{}(*tmp*)
chan1pos_list_nil
  (chpos) = () where
{
//
vtypedef
chan0 = $CHAN0.channel0(ptr, 2)
//
val
chan0 = $UN.castvwtp1{chan0}(chpos)
//
val () =
$CHAN0.channel0_send(chan0, 0, 1, $UN.int2ptr(0))
//
prval () = $UN.cast2void(chan0)
prval () = $UN.castview2void(chpos)
//
} (* end of [chan1pos_list_nil] *)
//
(* ****** ****** *)

implement
{}(*tmp*)
chan1pos_list_cons
  (chpos) = () where
{
//
vtypedef
chan0 = $CHAN0.channel0(ptr, 2)
//
val
chan0 = $UN.castvwtp1{chan0}(chpos)
//
val () =
$CHAN0.channel0_send(chan0, 0, 1, $UN.int2ptr(1))
//
prval () = $UN.cast2void(chan0)
prval () = $UN.castview2void(chpos)
//
} (* end of [chan1pos_list_cons] *)

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

implement
{}(*tmp*)
chan1neg_list
  (chneg) = let
//
vtypedef
chan0 = $CHAN0.channel0(ptr, 2)
val
chan0 = $UN.castvwtp1{chan0}(chneg)
//
val tag =
  $CHAN0.channel0_recv_val(chan0, 0, 1)
//
prval () = $UN.cast2void(chan0)
//
in
//
if
iseqz(tag)
then let
  prval () = $UN.castview2void(chneg) in chan1neg_list_nil()
end // end of [then]
else let
  prval () = $UN.castview2void(chneg) in chan1neg_list_cons()
end // end of [else]
//
end // end of [chan1neg_list]

(* ****** ****** *)
//
abst@ype bit = int
//
macdef B0 = $UN.cast{bit}(0)
macdef B1 = $UN.cast{bit}(1)
//
typedef bit_ = natLt(2)
//
extern castfn bit2bit_(bit): bit_
//
(* ****** ****** *)
//
extern
fun
int2bits
  {n:nat}(int(n)): chan1neg(ssn_list(bit))
//
(* ****** ****** *)

implement
int2bits(n) = let
//
fun
fserv{n:nat}
(
  n: int(n), chp: chan1pos(ssn_list(bit))
) : void = (
//
if
n > 0
then let
  val n2 = half(n)
  val bit =
  (
    if n = 2*n2 then B0 else B1
  ) : bit // end of [val]
  val () = chan1pos_list_cons(chp)
  val ((*void*)) = chan1pos_send<bit>(chp, bit)
in
  fserv (n2, chp)
end // end of [then]
else let
  val () = chan1pos_list_nil(chp) in channel1_close(chp)
end // end of [else]
//
) (* end of [fserv] *)
//
in
  chan1neg_create_exn{ssn_list(bit)}(llam(chp) => fserv (n, chp))
end // end of [int2bits]

(* ****** ****** *)
//
extern
fun
succ_bits
(
  chneg:
  chan1neg(ssn_list(bit))
) : chan1neg(ssn_list(bit))
//
(* ****** ****** *)

implement
succ_bits(chn) = let
//
fun
fserv
(
  chp: chan1pos(ssn_list(bit))
, chn: chan1neg(ssn_list(bit))
) : void = let
//
val opt = chan1neg_list(chn)
//
in
//
case+ opt of
| chan1neg_list_nil() => let
    val () =
      chan1pos_list_cons(chp)
    val () =
      chan1pos_send<bit>(chp, B1)
    val () =
      chan1pos_list_nil(chp)
    // end of [val]
    val () = channel1_close(chp)
    val () = channel1_close(chn)
  in
    // nothing
  end // end of [chan1neg_list_nil]
| chan1neg_list_cons() => let
    val () =
      chan1pos_list_cons (chp)
    val bit = chan1neg_send_val<bit> (chn)
    val bit_ = bit2bit_(bit)
  in
    if bit_ > 0
      then let
        val () =
          chan1pos_send (chp, B0)
        // end of [val]
      in
        fserv(chp, chn)
      end // end of [then]
      else let
        val () =
          chan1pos_send (chp, B1)
        // end of [val]
      in
        chan1posneg_elim(chp, chn)
      end // end of [else]
  end // end of [chan1neg_list_cons]
//
end // end of [fserv]
//
in
  chan1neg_create_exn{ssn_list(bit)}(llam(chp) => fserv (chp, chn))
end // end of [succ_bits]

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

extern
fun
add_bits_bits
(
  chan1neg(ssn_list(bit))
, chan1neg(ssn_list(bit))
) : chan1neg(ssn_list(bit))

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

implement
add_bits_bits
  (chn1, chn2) = let
//
fun
fserv
(
  chp: chan1pos(ssn_list(bit))
, chn1: chan1neg(ssn_list(bit))
, chn2: chan1neg(ssn_list(bit))
) : void = let
//
val opt1 = chan1neg_list (chn1)
//
in
//
case+ opt1 of
| chan1neg_list_nil() => let
    val () = channel1_close(chn1)
  in
    chan1posneg_elim (chp, chn2)
  end // end of [chan1neg_list_nil]
| chan1neg_list_cons() => let
    val () =
      chan1pos_list_cons (chp)
    // end of [val]
    val opt2 = chan1neg_list (chn2)
  in
    case+ opt2 of
    | chan1neg_list_nil() => let
        val () =
          channel1_close(chn2)
        // end of [val]
      in
        chan1posneg_elim(chp, chn1)
      end // end of [chan1neg_list_nil]
    | chan1neg_list_cons() => let
        val b1 = chan1neg_send_val(chn1)
        and b2 = chan1neg_send_val(chn2)
        val b1_ = bit2bit_(b1) and b2_ = bit2bit_(b2)
      in
        case+ b1_ of
        | 0 => (
            chan1pos_send(chp, b2); fserv(chp, chn1, chn2)
          ) (* end of [0] *)
        | 1 => (
            case+ b2_ of
            | 0 => (chan1pos_send(chp, B1); fserv(chp, chn1, chn2))
            | 1 => (chan1pos_send(chp, B0); fserv(chp, chn1, succ_bits(chn2)))
          ) (* end of [1] *)
      end // end of [chan1neg_list_cons]
  end // end of [chan1neg_list_cons]
//
end // end of [fserv]
//
in
  chan1neg_create_exn{ssn_list(bit)}(llam(chp) => fserv (chp, chn1, chn2))
end // end of [add_bits_bits]

(* ****** ****** *)
//
extern
fun
bits2int
(
  chn: chan1neg(ssn_list(bit))
) : intGte(0) // end-of-function
//
(* ****** ****** *)

implement
bits2int(chn) = let
//
fun
loop
(
  xs: List0_vt(bit), res: intGte(0)
) : intGte(0) =
(
case+ xs of
| ~list_vt_nil() => res
| ~list_vt_cons(x, xs) =>
    loop (xs, 2*res + bit2bit_(x))
) (* end of [loop] *)
//
//
fun
loop2
(
  chn: chan1neg(ssn_list(bit)), xs: List0_vt(bit)
) : List0_vt(bit) = let
//
val opt = chan1neg_list(chn)
//
in
//
case+ opt of
| chan1neg_list_nil() => let
    val () =
      channel1_close(chn) in xs
    // end of [val]
  end // end of [chan1neg_list_nil]
| chan1neg_list_cons() => let
    val x =
      chan1neg_send_val<bit> (chn)
    // end of [val]
  in
    loop2(chn, list_vt_cons(x, xs))
  end // end of [chan1neg_list_cons]
//
end // end of [loop2]
//
in
  loop(loop2(chn, list_vt_nil(*void*)), 0)
end // end of [bits2int]

(* ****** ****** *)
//
extern
fun
succ_int(intGte(0)): intGte(0)
//
(* ****** ****** *)
//
implement
succ_int(x) =
  bits2int(succ_bits(int2bits(x)))
//
(* ****** ****** *)
//
extern
fun
add_int_int(intGte(0), intGte(0)): intGte(0)
//
(* ****** ****** *)
//
implement
add_int_int(x, y) =
  bits2int(add_bits_bits(int2bits(x), int2bits(y)))
//
(* ****** ****** *)

implement
main0(argc, argv) =
{
//
val a0 =
(
if argc >= 2
  then g0string2int(argv[1]) else 0
// end of [if]
) : int // end of [val]
//
val a1 =
(
if argc >= 3
  then g0string2int(argv[2]) else 0
// end of [if]
) : int // end of [val]
//
val a0 = g1ofg0(a0)
and a1 = g1ofg0(a1)
//
val () = assertloc (a0 >= 0)
val () = assertloc (a1 >= 0)
//
val () =
println!
  (a0, " + ", a1, " = ", add_int_int(a0, a1))
//
val _(*left*) = $UNISTD.usleep(250000u)
//
} (* end of [main0] *)

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

(* end of [bitstr.dats] *)


Updating: very very minorly

Updating: very very minorly

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

#define ATS_DYNLOADFLAG 0

(* ****** ****** *)
//
extern
fun
hello(): string = "mac#"
//
implement
hello() =
"Hello from [patsopt+atscc2py3]!"
//
(* ****** ****** *)
%{^
import sys
######
from libatscc2py_all import *
######
sys.setrecursionlimit(1000000)
######
%} // end of [%{^]

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

(* end of [hello.dats] *)


Updating: scratching a bit

Updating: scratching a bit

(* ****** ****** *)
//
// HX-2014-12-23:
// For the purpose of
// studying session types
//
(* ****** ****** *)

(*
client1: send(int) -> recv(int)
client2: send(int) -> send(int) -> recv(int)
*)

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

(*
server1: recv(int) -> send(int)
server2: recv(int) -> recv(int) -> send(int)
*)

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

typedef str = string

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

stadef nil = unit_v
stadef :: (a:view, b:view) = (a, b)

(* ****** ****** *)
//
absview send_v (a:t@ype)
absview recv_v (a:t@ype)
//
(* ****** ****** *)
//
viewdef // for accessing a unary service
client1_v = send_v(int) :: recv_v(int) :: nil
viewdef // for accessing a binary service
client2_v = send_v(int) :: send_v(int) :: recv_v(int) :: nil
//
(* ****** ****** *)

viewdef // for providing a unary service
server1_v = recv_v(int) :: send_v(int) :: nil
viewdef // for providing a binary service
server2_v = recv_v(int) :: recv_v(int) :: send_v(int) :: nil

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

absview
adisj_v (v1:view, v2: view)
extern
praxi adisj_v_left : {v1,v2:view} (v1) -> adisj_v (v1, v2)
extern
praxi adisj_v_right : {v1,v2:view} (v2) -> adisj_v (v1, v2)

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

extern
fun client1 (pf: client1_v | (*void*)): void
extern
fun client2 (pf: client2_v | (*void*)): void

(* ****** ****** *)
//
absview
aconj (v1:view, v2:view)
datavtype
adisj_vt (v1:view, v2:view) =
  | adisj_vt_left (v1, v2) of (v1 | (*void*))
  | adisj_vt_right (v1, v2) of (v2 | (*void*))
//
(* ****** ****** *)
//
extern
fun inject_l{v1,v2:view}
(
  pf: !v1 >> adisj_v (v1, v2) | (*void*)
) : adisj_vt (v1, v2) // end of [inject_l]
extern
fun inject_r{v1,v2:view}
(
  pf: !v2 >> adisj_v (v1, v2) | (*void*)
) : adisj_vt (v1, v2) // end of [inject_r]
//
extern
fun choose_conj{v1,v2:view}
  (pf: aconj (v1, v2) | (*void*)): adisj_vt (v1, v2)
//
(* ****** ****** *)

extern
fun server1 (pf: server1_v | (*void*)): void
extern
fun server2 (pf: server2_v | (*void*)): void
extern // [server] combines [server1] and [server2]
fun server (pf: aconj (server1_v, server2_v) | (*void*)): void

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

implement
server(pf | (*void*)) = let
  val tag = choose_conj (pf | (*void*))
in
  case+ tag of
  | ~adisj_vt_left (pf1 | ) => server1 (pf1 | (*void*))
  | ~adisj_vt_right (pf2 | ) => server2 (pf2 | (*void*))
end // end of [server]

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

(* end of [scratch03.dats] *)

(* ****** ****** *)
//
// HX-2014-12-23:
// For the purpose of
// studying session types
//
(* ****** ****** *)

(*
client1: send(int) -> recv(int)
client2: send(int) -> send(int) -> recv(int)
*)

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

(*
server1: recv(int) -> send(int)
server2: recv(int) -> recv(int) -> send(int)
*)

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

typedef str = string

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

stadef nil = unit_v
stadef :: (a:view, b:view) = (a, b)

(* ****** ****** *)
//
absview send_v (a:t@ype)
absview recv_v (a:t@ype)
//
(* ****** ****** *)

viewdef
client1_v = send_v(int) :: recv_v(int) :: nil
viewdef
client2_v = send_v(int) :: send_v(int) :: recv_v(int) :: nil

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

viewdef
server1_v = recv_v(int) :: send_v(int) :: nil
viewdef
server2_v = recv_v(int) :: recv_v(int) :: send_v(int) :: nil

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

absview
adisj_v (v1:view, v2: view)
extern
praxi adisj_v_left : {v1,v2:view} (v1) -> adisj_v (v1, v2)
extern
praxi adisj_v_right : {v1,v2:view} (v2) -> adisj_v (v1, v2)

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

extern
fun client1 (pf: client1_v | (*void*)): void
extern
fun client2 (pf: client2_v | (*void*)): void

(* ****** ****** *)
//
absview
aconj (v1:view, v2:view)
datavtype
adisj_vt (v1:view, v2:view) =
  | adisj_vt_left (v1, v2) of (v1 | (*void*))
  | adisj_vt_right (v1, v2) of (v2 | (*void*))
//
(* ****** ****** *)
//
extern
fun inject_l{v1,v2:view}
(
  pf: !v1 >> adisj_v (v1, v2) | (*void*)
) : adisj_vt (v1, v2) // end of [inject_l]
extern
fun inject_r{v1,v2:view}
(
  pf: !v2 >> adisj_v (v1, v2) | (*void*)
) : adisj_vt (v1, v2) // end of [inject_r]
//
extern
fun choose_conj{v1,v2:view}
  (pf: aconj (v1, v2) | (*void*)): adisj_vt (v1, v2)
//
(* ****** ****** *)

extern
fun server1 (pf: server1_v | (*void*)): void
extern
fun server2 (pf: server2_v | (*void*)): void
extern
fun server (pf: aconj (server1_v, server2_v) | (*void*)): void

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

implement
server(pf | (*void*)) = let
  val tag = choose_conj (pf | (*void*))
in
  case+ tag of
  | ~adisj_vt_left (pf1 | ) => server1 (pf1 | (*void*))
  | ~adisj_vt_right (pf2 | ) => server2 (pf2 | (*void*))
end // end of [server]

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

(* end of [scratch03.dats] *)


Updating: very minorly improving

Updating: very minorly improving

(* ****** ****** *)
//
// Atscc2scm:
// from ATS to Scheme
//
(* ****** ****** *)
//
// HX-2016-05-19: start
//
(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
#define
CATSPARSEMIT_targetloc "./.CATS-parsemit"
//
(* ****** ****** *)
//
staload "{$CATSPARSEMIT}/catsparse.sats"
//
staload "{$CATSPARSEMIT}/catsparse_syntax.sats"
//
staload "{$CATSPARSEMIT}/catsparse_emit.sats"
//
staload "{$CATSPARSEMIT}/catsparse_typedef.sats"
staload "{$CATSPARSEMIT}/catsparse_fundecl.sats"
//
(* ****** ****** *)

local

staload
TM = "libc/SATS/time.sats"
stadef time_t = $TM.time_t

in (* in-of-local *)

implement
emit_time_stamp (out) = let
//
var tm: time_t
val () = tm := $TM.time_get ()
val (pfopt | p_tm) = $TM.localtime (tm)
//
val () = emit_text (out, ";;;;;;\n");
val () = emit_text (out, ";;\n");
val () = emit_text (out, ";; The Scheme code is generated by atscc2scm\n")
val () = emit_text (out, ";; The starting compilation time is: ")
//
val () =
if
p_tm > 0
then let
  prval Some_v @(pf1, fpf1) = pfopt
  val tm_min = $TM.tm_get_min (!p_tm)
  val tm_hour = $TM.tm_get_hour (!p_tm)
  val tm_mday = $TM.tm_get_mday (!p_tm)
  val tm_mon = 1 + $TM.tm_get_mon (!p_tm)
  val tm_year = 1900 + $TM.tm_get_year (!p_tm)
  prval () = fpf1 (pf1)
in
  $extfcall
  (
    void
  , "fprintf"
  , out, "%i-%i-%i: %2ih:%2im\n", tm_year, tm_mon, tm_mday, tm_hour, tm_min
  )
end // end of [then]
else let
  prval None_v () = pfopt
in
  emit_text (out, "**TIME-ERROR**\n")
end // end of [else]
//
val () = emit_text (out, ";;\n")
val () = emit_text (out, ";;;;;;\n")
//
in
  // emit_newline (out)
end // end of [emit_time_stamp]

end // end of [local]

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

implement
emit_PMVint
  (out, tok) = let
//
val-T_INT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVint]
//
implement
emit_PMVintrep
  (out, tok) = let
//
val-T_INT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVintrep]
//
(* ****** ****** *)

implement
emit_PMVbool
  (out, tfv) = (
//
emit_text
( out
, if tfv then "true" else "false"
) (* end of [emit_text] *)
//
) (* end of [emit_PMVbool] *)

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

implement
emit_PMVstring
  (out, tok) = let
//
val-T_STRING(rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVstring]

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

implement
emit_PMVfloat
  (out, tok) = let
//
val-T_FLOAT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVfloat]

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

implement
emit_PMVi0nt
  (out, tok) = let
//
val-T_INT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVi0nt]

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

implement
emit_PMVf0loat
  (out, tok) = let
//
val-T_FLOAT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVf0loat]

(* ****** ****** *)
//
implement
emit_PMVempty
  (out, _) = emit_text (out, "null")
//
implement
emit_PMVextval
  (out, toks) = emit_tokenlst (out, toks)
//
(* ****** ****** *)
//
extern
fun
f0ide_get_arity (fid: i0de): int
//
implement
f0ide_get_arity
  (fid) = let
//
val
opt =
f0head_search_opt(fid.i0dex_sym)
//
in
//
case+ opt of
| ~None_vt() => ~1
| ~Some_vt(fhd) =>
  (
    case+
    fhd.f0head_node
    of // case+
    | F0HEAD(fid, fma, _) =>
        list_length (fma.f0marg_node)
      // end of [F0HEAD]
  ) (* end of [Some_vt] *)
//
end // end of [f0ide_get_arity]
//
(* ****** ****** *)
//
extern
fun
emit_f0ide
  : emit_type (i0de) = "ext#atscc2scm_emit_f0ide"
extern
fun
emit_flabel
  : emit_type (label) = "ext#atscc2scm_emit_flabel"
//
implement
emit_f0ide
  (out, fid) = let
//
val sym = fid.i0dex_sym
val name = symbol_get_name(sym)
//
val c0 =
  $UN.ptr0_get<char> (string2ptr(name))
//
val () = if c0 = '_' then emit_text(out, "f")
//
in
  emit_symbol(out, sym)
end // end of [emit_f0ide]
//
implement
emit_flabel
  (out, flab) = emit_f0ide (out, flab)
//
(* ****** ****** *)
//
implement
emit_PMVfunlab
  (out, flab) =
{
//
val n0 = f0ide_get_arity(flab)
//
val () = emit_text(out, "fun ")
val () = emit_flabel (out, flab)
val () = (emit_text(out, "/"); emit_int(out, n0))
//
} (* end of [emit_PMVfunlab] *)
//
(* ****** ****** *)

implement
emit_PMVcfunlab
  (out, flab, d0es_env) =
{
//
val () = emit_LPAREN (out)
//
val () =
  emit_flabel (out, flab)
val () =
  emit_text (out, "__closurerize")
//
val () = emit_d0explst_1 (out, d0es_env)
val () = emit_RPAREN (out)
//
} (* end of [emit_PMVcfunlab] *)

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

implement
emit_CSTSPmyloc
  (out, tok) = let
//
val-T_STRING(rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_CSTSPmyloc]

(* ****** ****** *)
//
extern
fun
emit_fname_d0exp
  : (FILEref, string, d0exp) -> void
extern
fun
emit_fname_d0exp2
  : (FILEref, string, d0exp, d0exp) -> void
extern
fun
emit_fname_d0exp_int
  : (FILEref, string, d0exp, int(*ctag*)) -> void
//
implement
emit_fname_d0exp
  (out, fname, d0e) =
{
//
val () = emit_LPAREN (out)
//
val () = (
  emit_text (out, fname); emit_SPACE (out); emit_d0exp (out, d0e)
) (* end of [val] *)
//
val () = emit_RPAREN (out)
//
} (* end of [emit_fname_d0exp] *)
//
implement
emit_fname_d0exp2
  (out, fname, d0e1, d0e2) =
{
//
val () = emit_LPAREN (out)
val () =
(
  emit_text (out, fname); emit_SPACE (out);
  emit_d0exp (out, d0e1); emit_SPACE (out); emit_d0exp (out, d0e2)
)
val () = emit_RPAREN (out)
//
} (* end of [emit_fname_d0exp2] *)
//
implement
emit_fname_d0exp_int
  (out, fname, d0e, ctag) =
{
//
val () = emit_LPAREN (out)
val () =
(
  emit_text (out, fname); emit_SPACE (out);
  emit_d0exp (out, d0e); emit_SPACE (out); emit_int (out, ctag)
)
val () = emit_RPAREN (out)
//
} (* end of [emit_fname_d0exp_int] *)
//
(* ****** ****** *)
//
implement
emit_ATSCKiseqz(out, d0e) =
  emit_fname_d0exp(out, "ATSCKiseqz", d0e)
implement
emit_ATSCKisneqz(out, d0e) =
  emit_fname_d0exp(out, "ATSCKisneqz", d0e)
//
(* ****** ****** *)
//
implement
emit_ATSCKptriscons(out, d0e) =
  emit_fname_d0exp(out, "ATSCKptriscons", d0e)
implement
emit_ATSCKptrisnull(out, d0e) =
  emit_fname_d0exp(out, "ATSCKptrisnull", d0e)
//
(* ****** ****** *)
//
implement
emit_ATSCKpat_int
  (out, d0e, i0) =
  emit_fname_d0exp2 (out, "ATSCKpat_int", d0e, i0)
implement
emit_ATSCKpat_bool
  (out, d0e, b0) =
  emit_fname_d0exp2 (out, "ATSCKpat_bool", d0e, b0)
implement
emit_ATSCKpat_string
  (out, d0e, s0) =
  emit_fname_d0exp2 (out, "ATSCKpat_string", d0e, s0)
//
(* ****** ****** *)
//
implement
emit_ATSCKpat_con0
  (out, d0e, ctag) =
  emit_fname_d0exp_int (out, "ATSCKpat_con0", d0e, ctag)
implement
emit_ATSCKpat_con1
  (out, d0e, ctag) =
  emit_fname_d0exp_int (out, "ATSCKpat_con1", d0e, ctag)
//
(* ****** ****** *)
//
implement
emit_tmpvar
  (out, tmp) = let
//
val
sym = tmp.i0dex_sym
val
name =
g1ofg0(symbol_get_name(sym))
//
in
//
if
isneqz(name)
then (
  emit_text(out, name)
) (* end of [then] *)
else () // end of [else]
//
end // end of [emit_tmpvar]
//
(* ****** ****** *)

fun
s0exp_get_arity
  (s0e: s0exp): int =
(
case+
s0e.s0exp_node
of // case+
| S0Elist(s0es) => list_length(s0es) | _ => ~1
) (* end of [s0exp_get_arity] *)

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

implement
emit_d0exp
  (out, d0e0) = let
in
//
case+
d0e0.d0exp_node of
//
| D0Eide (tmp) =>
  {
    val () = emit_tmpvar (out, tmp)
  }
//
| D0Eappid (fid, d0es) =>
  {
    val () = emit_LPAREN (out)
    val () = emit_f0ide (out, fid)
    val () = emit_d0explst_1 (out, d0es)
    val () = emit_RPAREN (out)
  }
| D0Eappexp (d0e, d0es) =>
  {
    val () = emit_LPAREN (out)
    val () = emit_d0exp (out, d0e)
    val () = emit_d0explst_1 (out, d0es)
    val () = emit_RPAREN (out)
  }
//
| D0Elist (d0es) =>
  {
    val () = emit_LPAREN (out)
    val () = emit_text (out, "D0Elist")
    val () = emit_d0explst_1 (out, d0es)
    val () = emit_RPAREN (out)
  }
//
| ATSPMVint (int) => emit_PMVint (out, int)
| ATSPMVintrep (int) => emit_PMVintrep (out, int)
//
| ATSPMVbool (tfv) => emit_PMVbool (out, tfv)
//
| ATSPMVfloat (flt) => emit_PMVfloat (out, flt)
//
| ATSPMVstring (str) => emit_PMVstring (out, str)
//
| ATSPMVi0nt (int) => emit_PMVi0nt (out, int)
| ATSPMVf0loat (flt) => emit_PMVf0loat (out, flt)
//
| ATSPMVempty (dummy) => emit_PMVempty (out, 0)
| ATSPMVextval (toklst) => emit_PMVextval (out, toklst)
//
| ATSPMVrefarg0 (d0e) => emit_d0exp (out, d0e)
| ATSPMVrefarg1 (d0e) => emit_d0exp (out, d0e)
//
| ATSPMVfunlab (fl) => emit_PMVfunlab (out, fl)
| ATSPMVcfunlab
    (_(*knd*), fl, d0es) => emit_PMVcfunlab (out, fl, d0es)
  // end of [ATSPMVcfunlab]
//
| ATSPMVcastfn
    (_(*fid*), _(*s0e*), arg) => emit_d0exp (out, arg)
//
| ATSCSTSPmyloc (tok) => emit_CSTSPmyloc (out, tok)
//
//
| ATSCKiseqz(d0e) => emit_ATSCKiseqz (out, d0e)
| ATSCKisneqz(d0e) => emit_ATSCKisneqz (out, d0e)
| ATSCKptriscons(d0e) => emit_ATSCKptriscons (out, d0e)
| ATSCKptrisnull(d0e) => emit_ATSCKptrisnull (out, d0e)
//
| ATSCKpat_int
    (d0e, int) => emit_ATSCKpat_int (out, d0e, int)
| ATSCKpat_bool
    (d0e, bool) => emit_ATSCKpat_bool (out, d0e, bool)
| ATSCKpat_string
    (d0e, string) => emit_ATSCKpat_string (out, d0e, string)
//
| ATSCKpat_con0
    (d0e, ctag) => emit_ATSCKpat_con0 (out, d0e, ctag)
| ATSCKpat_con1
    (d0e, ctag) => emit_ATSCKpat_con1 (out, d0e, ctag)
//
| ATSSELcon _ => emit_SELcon (out, d0e0)
| ATSSELrecsin _ => emit_SELrecsin (out, d0e0)
| ATSSELboxrec _ => emit_SELboxrec (out, d0e0)
| ATSSELfltrec _ => emit_text (out, "ATSSELfltrec(...)")
//
| ATSextfcall
    (_fun, _arg) => {
    val () = emit_i0de (out, _fun)
    val () = emit_d0exparg (out, _arg)
  } (* end of [ATSextfcall] *)
| ATSextmcall
    (_obj, _mtd, _arg) => {
//
    val () = emit_d0exp (out, _obj)
    val () = emit_DOT (out)
    val () = emit_d0exp (out, _mtd)
//
    val () = emit_d0exparg (out, _arg)
//
  } (* end of [ATSextmcall] *)
//
| ATSfunclo_fun
  (
    d0e_fun, s0e_arg, _(*res*)
  ) =>
  {
    val () =
    emit_text
      (out, "?ATSfunclo_fun")
    // end of [val]
    val () =
    (
      emit_LPAREN (out); emit_d0exp (out, d0e_fun); emit_RPAREN (out)
    ) (* end of [val] *)
  } (* end of [ATSfunclo_fun] *)
//
| ATSfunclo_clo
  (
    d0e_fun, _(*arg*), _(*res*)
  ) =>
  {
    val () =
    emit_text(out, "?ATSfunclo_clo")
    val () =
    (
      emit_LPAREN (out); emit_d0exp (out, d0e_fun); emit_RPAREN (out)
    ) (* end of [val] *)
  } (* end of [ATSfunclo_clo] *)
//
end // end of [emit_d0exp]

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

local

fun
loop
(
  out: FILEref, d0es: d0explst, i: int
) : void =
(
case+ d0es of
| list_nil () => ()
| list_cons (d0e, d0es) => let
    val () =
      if i > 0 then emit_SPACE(out)
    // end of [val]
  in
    emit_d0exp (out, d0e); loop (out, d0es, i+1)
  end // end of [list_cons]
)

in (* in-of-local *)

implement
emit_d0explst (out, d0es) = loop (out, d0es, 0)
implement
emit_d0explst_1 (out, d0es) = loop (out, d0es, 1)

end // end of [local]

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

implement
emit_d0exparg
  (out, d0es) =
{
//
val () = emit_LPAREN (out)
val () = emit_d0explst (out, d0es)
val () = emit_RPAREN (out)
//
} (* end of [emit_d0exparg] *)

(* ****** ****** *)
//
extern
fun
tyrec_labsel
  (tyrec: tyrec, lab: symbol): int
//
implement
tyrec_labsel
  (tyrec, lab) = let
//
fun loop
(
  xs: tyfldlst, i: int
) : int =
(
case+ xs of
| list_cons (x, xs) => let
    val TYFLD (id, s0e) = x.tyfld_node
  in
    if lab = id.i0dex_sym then i else loop (xs, i+1)
  end // end of [list_cons
| list_nil ((*void*)) => ~1(*error*)
)
//
in
  loop (tyrec.tyrec_node, 0)
end // end of [tyrec_labsel]
//
(* ****** ****** *)

implement
emit_SELcon
  (out, d0e) = let
//
val-
ATSSELcon
  (d0rec, s0e, id) = d0e.d0exp_node
//
val-S0Eide(name) = s0e.s0exp_node
val-~Some_vt(s0rec) = typedef_search_opt(name)
//
val tupi = tyrec_labsel(s0rec, id.i0dex_sym)
//
val () =
emit_text
  (out, "(ATSSELcon ")
//
val () =
(
  emit_d0exp (out, d0rec); emit_SPACE(out); emit_int (out, tupi)
) (* end of [val] *)
//
val () = emit_RPAREN (out)
//
in
  // nothing
end // end of [emit_SELcon]

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

implement
emit_SELrecsin
  (out, d0e) = let
//
val-
ATSSELrecsin
  (d0rec, s0e, id) = d0e.d0exp_node
//
in
  emit_d0exp (out, d0rec)
end // end of [emit_SELrecsin]

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

implement
emit_SELboxrec
  (out, d0e) = let
//
val-
ATSSELboxrec
  (d0rec, s0e, id) = d0e.d0exp_node
//
val-S0Eide(name) = s0e.s0exp_node
val-~Some_vt(s0rec) = typedef_search_opt(name)
//
val tupi = tyrec_labsel(s0rec, id.i0dex_sym)
//
val () =
emit_text
  (out, "(ATSSELboxrec ")
//
//
val () =
(
  emit_d0exp (out, d0rec); emit_SPACE(out); emit_int (out, tupi)
) (* end of [val] *)
//
val () = emit_RPAREN (out)
//
in
  // nothing
end // end of [emit_SELboxrec]

(* ****** ****** *)
//
implement
emit_COMMENT_line
  (out, tok) = let
//
val-
T_COMMENT_line
  (str) = tok.token_node
//
in
  emit_text (out, str)
end // end of [emit_COMMENT_line]
//
implement
emit_COMMENT_block
  (out, tok) = let
//
val-
T_COMMENT_block
  (str) = tok.token_node
//
in
  emit_text (out, str)
end // end of [emit_COMMENT_block]
//
(* ****** ****** *)

local

fun
aux0_cenv
(
  out: FILEref
, s0es: s0explst
) : void = let
//
fun
auxlst
(
  i: int, s0es: s0explst
) : void =
(
case+ s0es of
| list_nil() => ()
| list_cons
    (_, s0es) => let
    val () =
      emit_text(out, ", ")
    val () =
    (
      emit_text(out, "Cenv"); emit_int(out, i)
    )
  in
    auxlst(i+1, s0es)
  end // end of [auxlst]
)
//
val () = emit_LBRACE(out)
val () = (emit_text(out, "_"); auxlst(1, s0es))
val () = emit_RBRACE(out)
//
in
  // nothing
end (* end of [aux0_cenv] *)

fun
aux0_arglst
(
  out: FILEref
, s0es: s0explst
, n0: int, i: int
) : void = (
//
case+ s0es of
| list_nil
    ((*void*)) => ()
| list_cons
    (s0e, s0es) => let
    val () =
    if n0+i > 0
      then emit_text (out, ", ")
    // end of [val]
    val () =
    (
      emit_text (out, "XArg"); emit_int (out, i)
    ) (* end of [val] *)
  in
    aux0_arglst (out, s0es, n0, i+1)
  end // end of [list_cons]
//
) (* end of [aux0_arglst] *)

fun
aux0_envlst
(
  out: FILEref
, s0es: s0explst
, n0: int, i: int
) : void = (
//
case+ s0es of
| list_nil () => ()
| list_cons
    (s0e, s0es) => let
    val () =
    if n0+i > 0
      then emit_text (out, ", ")
    // end of [val]
    val () =
    (
      emit_text (out, "XEnv"); emit_int (out, i)
    ) (* end of [val] *)
  in
    aux0_envlst (out, s0es, n0, i+1)
  end // end of [list_cons]
//
) (* end of [aux0_envlst] *)

fun
aux1_envlst
(
  out: FILEref
, s0es: s0explst, i: int
) : int =
(
case+ s0es of
| list_nil
    ((*void*)) => (i)
| list_cons
    (s0e, s0es) => let
    val () =
    if i > 0
      then emit_text (out, ", ")
    // end of [val]
    val () =
    (
      emit_text (out, "Cenv"); emit_int (out, i+1)
    ) (* end of [val] *)
  in
    aux1_envlst (out, s0es, i+1)
  end // end of [list_cons]
) (* end of [aux1_envlst] *)

in (* in-of-local *)

implement
emit_closurerize
(
  out, flab, env, arg, res
) = let
//
val-S0Elist(s0es_env) = env.s0exp_node
val-S0Elist(s0es_arg) = arg.s0exp_node
//
val () = emit_ENDL (out)
//
(*
val () =
emit_text (out, ";;fun;;\n")
*)
val () = emit_flabel (out, flab)
val () =
emit_text (out, "__closurerize(")
val () = aux0_envlst (out, s0es_env, 0, 0)
val ((*closing*)) = emit_text (out, ") -> \n")
//
val ((*opening*)) = emit_text (out, "%{\n")
//
val () = emit_nspc (out, 2)
val () = emit_text (out, "{")
val () = emit_text (out, "fun(")
//
val () = aux0_cenv (out, s0es_env)
val () = aux0_arglst (out, s0es_arg, 1, 0)
//
val () = emit_text (out, ") -> ")
//
val () = emit_flabel (out, flab)
//
val () = emit_LPAREN (out)
val n0 = aux1_envlst (out, s0es_env, 0)
val () = aux0_arglst (out, s0es_arg, n0, 0)
val () = emit_RPAREN (out)
//
val () = emit_text (out, " end")
//
val () = aux0_envlst (out, s0es_env, 1, 0)
val ((*closing*)) = emit_text (out, "}.\n%}\n")
//
val ((*flushing*)) = emit_newline (out)
//
in
  // nothing
end // end of [emit_closurerize]

end // end of [local]

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

(* end of [atscc2scm_emit.dats] *)

(* ****** ****** *)
//
// Atscc2scm:
// from ATS to Scheme
//
(* ****** ****** *)
//
// HX-2016-05-19: start
//
(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
#define
CATSPARSEMIT_targetloc "./.CATS-parsemit"
//
(* ****** ****** *)
//
staload "{$CATSPARSEMIT}/catsparse.sats"
//
staload "{$CATSPARSEMIT}/catsparse_syntax.sats"
//
staload "{$CATSPARSEMIT}/catsparse_emit.sats"
//
staload "{$CATSPARSEMIT}/catsparse_typedef.sats"
staload "{$CATSPARSEMIT}/catsparse_fundecl.sats"
//
(* ****** ****** *)

local

staload
TM = "libc/SATS/time.sats"
stadef time_t = $TM.time_t

in (* in-of-local *)

implement
emit_time_stamp (out) = let
//
var tm: time_t
val () = tm := $TM.time_get ()
val (pfopt | p_tm) = $TM.localtime (tm)
//
val () = emit_text (out, ";;;;;;\n");
val () = emit_text (out, ";;\n");
val () = emit_text (out, ";; The Scheme code is generated by atscc2scm\n")
val () = emit_text (out, ";; The starting compilation time is: ")
//
val () =
if
p_tm > 0
then let
  prval Some_v @(pf1, fpf1) = pfopt
  val tm_min = $TM.tm_get_min (!p_tm)
  val tm_hour = $TM.tm_get_hour (!p_tm)
  val tm_mday = $TM.tm_get_mday (!p_tm)
  val tm_mon = 1 + $TM.tm_get_mon (!p_tm)
  val tm_year = 1900 + $TM.tm_get_year (!p_tm)
  prval () = fpf1 (pf1)
in
  $extfcall
  (
    void
  , "fprintf"
  , out, "%i-%i-%i: %2ih:%2im\n", tm_year, tm_mon, tm_mday, tm_hour, tm_min
  )
end // end of [then]
else let
  prval None_v () = pfopt
in
  emit_text (out, "**TIME-ERROR**\n")
end // end of [else]
//
val () = emit_text (out, ";;\n")
val () = emit_text (out, ";;;;;;\n")
//
in
  // emit_newline (out)
end // end of [emit_time_stamp]

end // end of [local]

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

implement
emit_PMVint
  (out, tok) = let
//
val-T_INT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVint]
//
implement
emit_PMVintrep
  (out, tok) = let
//
val-T_INT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVintrep]
//
(* ****** ****** *)

implement
emit_PMVbool
  (out, tfv) = (
//
emit_text
( out
, if tfv then "true" else "false"
) (* end of [emit_text] *)
//
) (* end of [emit_PMVbool] *)

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

implement
emit_PMVstring
  (out, tok) = let
//
val-T_STRING(rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVstring]

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

implement
emit_PMVfloat
  (out, tok) = let
//
val-T_FLOAT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVfloat]

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

implement
emit_PMVi0nt
  (out, tok) = let
//
val-T_INT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVi0nt]

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

implement
emit_PMVf0loat
  (out, tok) = let
//
val-T_FLOAT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVf0loat]

(* ****** ****** *)
//
implement
emit_PMVempty
  (out, _) = emit_text (out, "null")
//
implement
emit_PMVextval
  (out, toks) = emit_tokenlst (out, toks)
//
(* ****** ****** *)
//
extern
fun
f0ide_get_arity (fid: i0de): int
//
implement
f0ide_get_arity
  (fid) = let
//
val
opt =
f0head_search_opt(fid.i0dex_sym)
//
in
//
case+ opt of
| ~None_vt() => ~1
| ~Some_vt(fhd) =>
  (
    case+
    fhd.f0head_node
    of // case+
    | F0HEAD(fid, fma, _) =>
        list_length (fma.f0marg_node)
      // end of [F0HEAD]
  ) (* end of [Some_vt] *)
//
end // end of [f0ide_get_arity]
//
(* ****** ****** *)
//
extern
fun
emit_f0ide
  : emit_type (i0de) = "ext#atscc2scm_emit_f0ide"
extern
fun
emit_flabel
  : emit_type (label) = "ext#atscc2scm_emit_flabel"
//
implement
emit_f0ide
  (out, fid) = let
//
val sym = fid.i0dex_sym
val name = symbol_get_name(sym)
//
val c0 =
  $UN.ptr0_get<char> (string2ptr(name))
//
val () = if c0 = '_' then emit_text(out, "f")
//
in
  emit_symbol(out, sym)
end // end of [emit_f0ide]
//
implement
emit_flabel
  (out, flab) = emit_f0ide (out, flab)
//
(* ****** ****** *)
//
implement
emit_PMVfunlab
  (out, flab) =
{
//
val n0 = f0ide_get_arity(flab)
//
val () = emit_text(out, "fun ")
val () = emit_flabel (out, flab)
val () = (emit_text(out, "/"); emit_int(out, n0))
//
} (* end of [emit_PMVfunlab] *)
//
(* ****** ****** *)

implement
emit_PMVcfunlab
  (out, flab, d0es_env) =
{
//
val () = emit_LPAREN (out)
//
val () =
  emit_flabel (out, flab)
val () =
  emit_text (out, "__closurerize")
//
val () = emit_d0explst_1 (out, d0es_env)
val () = emit_RPAREN (out)
//
} (* end of [emit_PMVcfunlab] *)

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

implement
emit_CSTSPmyloc
  (out, tok) = let
//
val-T_STRING(rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_CSTSPmyloc]

(* ****** ****** *)
//
extern
fun
emit_fname_d0exp
  : (FILEref, string, d0exp) -> void
extern
fun
emit_fname_d0exp2
  : (FILEref, string, d0exp, d0exp) -> void
extern
fun
emit_fname_d0exp_int
  : (FILEref, string, d0exp, int(*ctag*)) -> void
//
(* ****** ****** *)
//
implement
emit_ATSCKiseqz(out, d0e) =
  emit_fname_d0exp(out, "ATSCKiseqz", d0e)
implement
emit_ATSCKisneqz(out, d0e) =
  emit_fname_d0exp(out, "ATSCKisneqz", d0e)
//
(* ****** ****** *)
//
implement
emit_ATSCKptriscons(out, d0e) =
  emit_fname_d0exp(out, "ATSCKptriscons", d0e)
implement
emit_ATSCKptrisnull(out, d0e) =
  emit_fname_d0exp(out, "ATSCKptrisnull", d0e)
//
(* ****** ****** *)
//
implement
emit_ATSCKpat_int
  (out, d0e, i0) =
  emit_fname_d0exp2 (out, "ATSCKpat_int", d0e, i0)
implement
emit_ATSCKpat_bool
  (out, d0e, b0) =
  emit_fname_d0exp2 (out, "ATSCKpat_bool", d0e, b0)
implement
emit_ATSCKpat_string
  (out, d0e, s0) =
  emit_fname_d0exp2 (out, "ATSCKpat_string", d0e, s0)
//
(* ****** ****** *)
//
implement
emit_ATSCKpat_con0
  (out, d0e, ctag) =
  emit_fname_d0exp_int (out, "ATSCKpat_con0", d0e, ctag)
implement
emit_ATSCKpat_con1
  (out, d0e, ctag) =
  emit_fname_d0exp_int (out, "ATSCKpat_con1", d0e, ctag)
//
(* ****** ****** *)
//
implement
emit_tmpvar
  (out, tmp) = let
//
val
sym = tmp.i0dex_sym
val
name =
g1ofg0(symbol_get_name(sym))
//
in
//
if
isneqz(name)
then (
  emit_text(out, name)
) (* end of [then] *)
else () // end of [else]
//
end // end of [emit_tmpvar]
//
(* ****** ****** *)

fun
s0exp_get_arity
  (s0e: s0exp): int =
(
case+
s0e.s0exp_node
of // case+
| S0Elist(s0es) => list_length(s0es) | _ => ~1
) (* end of [s0exp_get_arity] *)

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

implement
emit_d0exp
  (out, d0e0) = let
in
//
case+
d0e0.d0exp_node of
//
| D0Eide (tmp) =>
  {
    val () = emit_tmpvar (out, tmp)
  }
//
| D0Eappid (fid, d0es) =>
  {
    val () = emit_LPAREN (out)
    val () = emit_f0ide (out, fid)
    val () = emit_d0explst_1 (out, d0es)
    val () = emit_RPAREN (out)
  }
| D0Eappexp (d0e, d0es) =>
  {
    val () = emit_LPAREN (out)
    val () = emit_d0exp (out, d0e)
    val () = emit_d0explst_1 (out, d0es)
    val () = emit_RPAREN (out)
  }
//
| D0Elist (d0es) =>
  {
    val () = emit_LPAREN (out)
    val () = emit_text (out, "D0Elist")
    val () = emit_d0explst_1 (out, d0es)
    val () = emit_RPAREN (out)
  }
//
| ATSPMVint (int) => emit_PMVint (out, int)
| ATSPMVintrep (int) => emit_PMVintrep (out, int)
//
| ATSPMVbool (tfv) => emit_PMVbool (out, tfv)
//
| ATSPMVfloat (flt) => emit_PMVfloat (out, flt)
//
| ATSPMVstring (str) => emit_PMVstring (out, str)
//
| ATSPMVi0nt (int) => emit_PMVi0nt (out, int)
| ATSPMVf0loat (flt) => emit_PMVf0loat (out, flt)
//
| ATSPMVempty (dummy) => emit_PMVempty (out, 0)
| ATSPMVextval (toklst) => emit_PMVextval (out, toklst)
//
| ATSPMVrefarg0 (d0e) => emit_d0exp (out, d0e)
| ATSPMVrefarg1 (d0e) => emit_d0exp (out, d0e)
//
| ATSPMVfunlab (fl) => emit_PMVfunlab (out, fl)
| ATSPMVcfunlab
    (_(*knd*), fl, d0es) => emit_PMVcfunlab (out, fl, d0es)
  // end of [ATSPMVcfunlab]
//
| ATSPMVcastfn
    (_(*fid*), _(*s0e*), arg) => emit_d0exp (out, arg)
//
| ATSCSTSPmyloc (tok) => emit_CSTSPmyloc (out, tok)
//
//
| ATSCKiseqz(d0e) => emit_ATSCKiseqz (out, d0e)
| ATSCKisneqz(d0e) => emit_ATSCKisneqz (out, d0e)
| ATSCKptriscons(d0e) => emit_ATSCKptriscons (out, d0e)
| ATSCKptrisnull(d0e) => emit_ATSCKptrisnull (out, d0e)
//
| ATSCKpat_int
    (d0e, int) => emit_ATSCKpat_int (out, d0e, int)
| ATSCKpat_bool
    (d0e, bool) => emit_ATSCKpat_bool (out, d0e, bool)
| ATSCKpat_string
    (d0e, string) => emit_ATSCKpat_string (out, d0e, string)
//
| ATSCKpat_con0
    (d0e, ctag) => emit_ATSCKpat_con0 (out, d0e, ctag)
| ATSCKpat_con1
    (d0e, ctag) => emit_ATSCKpat_con1 (out, d0e, ctag)
//
| ATSSELcon _ => emit_SELcon (out, d0e0)
| ATSSELrecsin _ => emit_SELrecsin (out, d0e0)
| ATSSELboxrec _ => emit_SELboxrec (out, d0e0)
| ATSSELfltrec _ => emit_text (out, "ATSSELfltrec(...)")
//
| ATSextfcall
    (_fun, _arg) => {
    val () = emit_i0de (out, _fun)
    val () = emit_d0exparg (out, _arg)
  } (* end of [ATSextfcall] *)
| ATSextmcall
    (_obj, _mtd, _arg) => {
//
    val () = emit_d0exp (out, _obj)
    val () = emit_DOT (out)
    val () = emit_d0exp (out, _mtd)
//
    val () = emit_d0exparg (out, _arg)
//
  } (* end of [ATSextmcall] *)
//
| ATSfunclo_fun
  (
    d0e_fun, s0e_arg, _(*res*)
  ) =>
  {
    val () =
    emit_text
      (out, "?ATSfunclo_fun")
    // end of [val]
    val () =
    (
      emit_LPAREN (out); emit_d0exp (out, d0e_fun); emit_RPAREN (out)
    ) (* end of [val] *)
  } (* end of [ATSfunclo_fun] *)
//
| ATSfunclo_clo
  (
    d0e_fun, _(*arg*), _(*res*)
  ) =>
  {
    val () =
    emit_text(out, "?ATSfunclo_clo")
    val () =
    (
      emit_LPAREN (out); emit_d0exp (out, d0e_fun); emit_RPAREN (out)
    ) (* end of [val] *)
  } (* end of [ATSfunclo_clo] *)
//
end // end of [emit_d0exp]

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

local

fun
loop
(
  out: FILEref, d0es: d0explst, i: int
) : void =
(
case+ d0es of
| list_nil () => ()
| list_cons (d0e, d0es) => let
    val () =
      if i > 0 then emit_SPACE(out)
    // end of [val]
  in
    emit_d0exp (out, d0e); loop (out, d0es, i+1)
  end // end of [list_cons]
)

in (* in-of-local *)

implement
emit_d0explst (out, d0es) = loop (out, d0es, 0)
implement
emit_d0explst_1 (out, d0es) = loop (out, d0es, 1)

end // end of [local]

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

implement
emit_d0exparg
  (out, d0es) =
{
//
val () = emit_LPAREN (out)
val () = emit_d0explst (out, d0es)
val () = emit_RPAREN (out)
//
} (* end of [emit_d0exparg] *)

(* ****** ****** *)
//
extern
fun
tyrec_labsel
  (tyrec: tyrec, lab: symbol): int
//
implement
tyrec_labsel
  (tyrec, lab) = let
//
fun loop
(
  xs: tyfldlst, i: int
) : int =
(
case+ xs of
| list_cons (x, xs) => let
    val TYFLD (id, s0e) = x.tyfld_node
  in
    if lab = id.i0dex_sym then i else loop (xs, i+1)
  end // end of [list_cons
| list_nil ((*void*)) => ~1(*error*)
)
//
in
  loop (tyrec.tyrec_node, 0)
end // end of [tyrec_labsel]
//
(* ****** ****** *)

implement
emit_SELcon
  (out, d0e) = let
//
val-
ATSSELcon
  (d0rec, s0e, id) = d0e.d0exp_node
//
val-S0Eide(name) = s0e.s0exp_node
val-~Some_vt(s0rec) = typedef_search_opt(name)
//
val tupi = tyrec_labsel(s0rec, id.i0dex_sym)
//
val () =
emit_text
  (out, "(ATSSELcon ")
//
val () =
(
  emit_d0exp (out, d0rec); emit_SPACE(out); emit_int (out, tupi)
) (* end of [val] *)
//
val () = emit_RPAREN (out)
//
in
  // nothing
end // end of [emit_SELcon]

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

implement
emit_SELrecsin
  (out, d0e) = let
//
val-
ATSSELrecsin
  (d0rec, s0e, id) = d0e.d0exp_node
//
in
  emit_d0exp (out, d0rec)
end // end of [emit_SELrecsin]

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

implement
emit_SELboxrec
  (out, d0e) = let
//
val-
ATSSELboxrec
  (d0rec, s0e, id) = d0e.d0exp_node
//
val-S0Eide(name) = s0e.s0exp_node
val-~Some_vt(s0rec) = typedef_search_opt(name)
//
val tupi = tyrec_labsel(s0rec, id.i0dex_sym)
//
val () =
emit_text
  (out, "(ATSSELboxrec ")
//
//
val () =
(
  emit_d0exp (out, d0rec); emit_SPACE(out); emit_int (out, tupi)
) (* end of [val] *)
//
val () = emit_RPAREN (out)
//
in
  // nothing
end // end of [emit_SELboxrec]

(* ****** ****** *)
//
implement
emit_COMMENT_line
  (out, tok) = let
//
val-
T_COMMENT_line
  (str) = tok.token_node
//
in
  emit_text (out, str)
end // end of [emit_COMMENT_line]
//
implement
emit_COMMENT_block
  (out, tok) = let
//
val-
T_COMMENT_block
  (str) = tok.token_node
//
in
  emit_text (out, str)
end // end of [emit_COMMENT_block]
//
(* ****** ****** *)

local

fun
aux0_cenv
(
  out: FILEref
, s0es: s0explst
) : void = let
//
fun
auxlst
(
  i: int, s0es: s0explst
) : void =
(
case+ s0es of
| list_nil() => ()
| list_cons
    (_, s0es) => let
    val () =
      emit_text(out, ", ")
    val () =
    (
      emit_text(out, "Cenv"); emit_int(out, i)
    )
  in
    auxlst(i+1, s0es)
  end // end of [auxlst]
)
//
val () = emit_LBRACE(out)
val () = (emit_text(out, "_"); auxlst(1, s0es))
val () = emit_RBRACE(out)
//
in
  // nothing
end (* end of [aux0_cenv] *)

fun
aux0_arglst
(
  out: FILEref
, s0es: s0explst
, n0: int, i: int
) : void = (
//
case+ s0es of
| list_nil
    ((*void*)) => ()
| list_cons
    (s0e, s0es) => let
    val () =
    if n0+i > 0
      then emit_text (out, ", ")
    // end of [val]
    val () =
    (
      emit_text (out, "XArg"); emit_int (out, i)
    ) (* end of [val] *)
  in
    aux0_arglst (out, s0es, n0, i+1)
  end // end of [list_cons]
//
) (* end of [aux0_arglst] *)

fun
aux0_envlst
(
  out: FILEref
, s0es: s0explst
, n0: int, i: int
) : void = (
//
case+ s0es of
| list_nil () => ()
| list_cons
    (s0e, s0es) => let
    val () =
    if n0+i > 0
      then emit_text (out, ", ")
    // end of [val]
    val () =
    (
      emit_text (out, "XEnv"); emit_int (out, i)
    ) (* end of [val] *)
  in
    aux0_envlst (out, s0es, n0, i+1)
  end // end of [list_cons]
//
) (* end of [aux0_envlst] *)

fun
aux1_envlst
(
  out: FILEref
, s0es: s0explst, i: int
) : int =
(
case+ s0es of
| list_nil
    ((*void*)) => (i)
| list_cons
    (s0e, s0es) => let
    val () =
    if i > 0
      then emit_text (out, ", ")
    // end of [val]
    val () =
    (
      emit_text (out, "Cenv"); emit_int (out, i+1)
    ) (* end of [val] *)
  in
    aux1_envlst (out, s0es, i+1)
  end // end of [list_cons]
) (* end of [aux1_envlst] *)

in (* in-of-local *)

implement
emit_closurerize
(
  out, flab, env, arg, res
) = let
//
val-S0Elist(s0es_env) = env.s0exp_node
val-S0Elist(s0es_arg) = arg.s0exp_node
//
val () = emit_ENDL (out)
//
(*
val () =
emit_text (out, ";;fun;;\n")
*)
val () = emit_flabel (out, flab)
val () =
emit_text (out, "__closurerize(")
val () = aux0_envlst (out, s0es_env, 0, 0)
val ((*closing*)) = emit_text (out, ") -> \n")
//
val ((*opening*)) = emit_text (out, "%{\n")
//
val () = emit_nspc (out, 2)
val () = emit_text (out, "{")
val () = emit_text (out, "fun(")
//
val () = aux0_cenv (out, s0es_env)
val () = aux0_arglst (out, s0es_arg, 1, 0)
//
val () = emit_text (out, ") -> ")
//
val () = emit_flabel (out, flab)
//
val () = emit_LPAREN (out)
val n0 = aux1_envlst (out, s0es_env, 0)
val () = aux0_arglst (out, s0es_arg, n0, 0)
val () = emit_RPAREN (out)
//
val () = emit_text (out, " end")
//
val () = aux0_envlst (out, s0es_env, 1, 0)
val ((*closing*)) = emit_text (out, "}.\n%}\n")
//
val ((*flushing*)) = emit_newline (out)
//
in
  // nothing
end // end of [emit_closurerize]

end // end of [local]

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

(* end of [atscc2scm_emit.dats] *)


Add termination metrics

Add termination metrics

#include "config.hats"
#include "{$TOP}/avr_prelude/kernel_staload.hats"

staload "{$TOP}/SATS/arduino.sats"
staload "{$TOP}/SATS/lcd.sats"

#define MY_DELAY_MS 400.0
#define LCD_WIDTH 16

val g_str_atsrun = "<ATS running!>"
val g_str_message = "                 ATS is a statically typed programming language that unifies implementation with formal specification. It is equipped with a highly expressive type system rooted in the framework Applied Type System, which gives the language its name. In particular, both dependent types and linear types are available in ATS.                 "

implement main () = {
  fun loop {n:int}{i:nat | i < n} .<n-i>.
           (lcd: !lcd_t, str: string (n), pos: size_t (i)): void = {
    val () = if pos + i2sz LCD_WIDTH <= length str then {
      val () = (lcd_setCursor (lcd, 1, 0); lcd_print (lcd, g_str_atsrun, i2sz 0, length g_str_atsrun))
      val () = (lcd_setCursor (lcd, 0, 1); lcd_print (lcd, str, pos, i2sz LCD_WIDTH))
      val () = delay_ms (MY_DELAY_MS)
      val () = loop (lcd, str, pos + 1)
    }
  }
  fun forever {n:int}{i:nat | i < n}
              (lcd: !lcd_t, str: string (n), pos: size_t (i)): void = {
    val () = loop (lcd, str, pos)
    val () = forever (lcd, str, pos)
  }
  val lcd = lcd_open (8, 13, 9, 4, 5, 6, 7)
  val () = forever (lcd, g_str_message, i2sz 0)
  val () = lcd_close lcd
}

#include "config.hats"
#include "{$TOP}/avr_prelude/kernel_staload.hats"

staload "{$TOP}/SATS/arduino.sats"
staload "{$TOP}/SATS/lcd.sats"

#define MY_DELAY_MS 400.0
#define LCD_WIDTH 16

val g_str_atsrun = "<ATS running!>"
val g_str_message = "                 ATS is a statically typed programming language that unifies implementation with formal specification. It is equipped with a highly expressive type system rooted in the framework Applied Type System, which gives the language its name. In particular, both dependent types and linear types are available in ATS.                 "

implement main () = {
  fun loop {n:int}{i:nat | i < n}
           (lcd: !lcd_t, str: string (n), pos: size_t (i)): void = {
    val () = if pos + i2sz LCD_WIDTH <= length str then {
      val () = (lcd_setCursor (lcd, 1, 0); lcd_print (lcd, g_str_atsrun, i2sz 0, length g_str_atsrun))
      val () = (lcd_setCursor (lcd, 0, 1); lcd_print (lcd, str, pos, i2sz LCD_WIDTH))
      val () = delay_ms (MY_DELAY_MS)
      val () = loop (lcd, str, pos + 1)
    }
  }
  fun forever {n:int}{i:nat | i < n}
              (lcd: !lcd_t, str: string (n), pos: size_t (i)): void = {
    val () = loop (lcd, str, pos)
    val () = forever (lcd, str, pos)
  }
  val lcd = lcd_open (8, 13, 9, 4, 5, 6, 7)
  val () = forever (lcd, g_str_message, i2sz 0)
  val () = lcd_close lcd
}


Updating: very minorly improving

Updating: very minorly improving

(* ****** ****** *)
//
// Atscc2js:
// from ATS to JavaScript
//
(* ****** ****** *)
//
// HX-2014-08-20: start
// HX-2015-05-21: restructure
//
(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
#define
CATSPARSEMIT_targetloc "./.CATS-parsemit"
//
(* ****** ****** *)
//
staload "{$CATSPARSEMIT}/catsparse.sats"
//
staload "{$CATSPARSEMIT}/catsparse_syntax.sats"
//
staload "{$CATSPARSEMIT}/catsparse_emit.sats"
//
staload "{$CATSPARSEMIT}/catsparse_typedef.sats"
//
(* ****** ****** *)

local

staload
TM = "libc/SATS/time.sats"
stadef time_t = $TM.time_t

in (* in-of-local *)

implement
emit_time_stamp (out) = let
//
var tm: time_t
val () = tm := $TM.time_get ()
val (pfopt | p_tm) = $TM.localtime (tm)
//
val () = emit_text (out, "/*\n");
val () = emit_text (out, "**\n");
val () = emit_text (out, "** The JavaScript code is generated by atscc2js\n")
val () = emit_text (out, "** The starting compilation time is: ")
//
val () =
if
p_tm > 0
then let
  prval Some_v @(pf1, fpf1) = pfopt
  val tm_min = $TM.tm_get_min (!p_tm)
  val tm_hour = $TM.tm_get_hour (!p_tm)
  val tm_mday = $TM.tm_get_mday (!p_tm)
  val tm_mon = 1 + $TM.tm_get_mon (!p_tm)
  val tm_year = 1900 + $TM.tm_get_year (!p_tm)
  prval () = fpf1 (pf1)
in
  $extfcall
  (
    void
  , "fprintf"
  , out, "%i-%i-%i: %2ih:%2im\n", tm_year, tm_mon, tm_mday, tm_hour, tm_min
  )
end // end of [then]
else let
  prval None_v () = pfopt
in
  emit_text (out, "**TIME-ERROR**\n")
end // end of [else]
//
val () = emit_text (out, "**\n")
val () = emit_text (out, "*/\n")
//
in
  // emit_newline (out)
end // end of [emit_time_stamp]

end // end of [local]

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

implement
emit_PMVint
  (out, tok) = let
//
val-T_INT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVint]
//
implement
emit_PMVintrep
  (out, tok) = let
//
val-T_INT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVintrep]
//
(* ****** ****** *)

implement
emit_PMVbool
  (out, tfv) =
(
  emit_text (out, if tfv then "true" else "false")
) (* end of [emit_PMVbool] *)

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

implement
emit_PMVstring
  (out, tok) = let
//
val-T_STRING(rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVstring]

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

implement
emit_PMVfloat
  (out, tok) = let
//
val-T_FLOAT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVfloat]

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

implement
emit_PMVi0nt
  (out, tok) = let
//
val-T_INT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVi0nt]

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

implement
emit_PMVf0loat
  (out, tok) = let
//
val-T_FLOAT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVf0loat]

(* ****** ****** *)
//
implement
emit_PMVempty
  (out, _) = emit_text (out, "null")
//
implement
emit_PMVextval
  (out, toks) = emit_tokenlst (out, toks)
//
(* ****** ****** *)
//
implement
emit_PMVfunlab
  (out, flab) = emit_label (out, flab)
//
(* ****** ****** *)

implement
emit_PMVcfunlab
  (out, fl, d0es) =
{
//
val () =
  emit_label (out, fl)
val () =
  emit_text (out, "__closurerize")
//
val () = emit_LPAREN (out)
val () = emit_d0explst (out, d0es)
val () = emit_RPAREN (out)
//
} (* end of [emit_PMVcfunlab] *)

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

implement
emit_CSTSPmyloc
  (out, tok) = let
//
val-T_STRING(rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_CSTSPmyloc]

(* ****** ****** *)
//
extern
fun
emit_fname_d0exp
  : (FILEref, string, d0exp) -> void
extern
fun
emit_fname_d0exp2
  : (FILEref, string, d0exp, d0exp) -> void
//
implement
emit_fname_d0exp
  (out, fname, d0e) =
{
//
val () =
  emit_text (out, fname)
val () = emit_LPAREN (out)
val () = emit_d0exp (out, d0e)
val () = emit_RPAREN (out)
//
} (* end of [emit_fname_d0exp] *)
//
implement
emit_fname_d0exp2
  (out, fname, d0e1, d0e2) =
{
//
val () =
  emit_text (out, fname)
//
val () = emit_LPAREN (out)
val () =
(
  emit_d0exp (out, d0e1); emit_text (out, ", "); emit_d0exp (out, d0e2)
)
val () = emit_RPAREN (out)
//
} (* end of [emit_fname_d0exp2] *)
//
(* ****** ****** *)
//
implement
emit_ATSCKiseqz(out, d0e) =
  emit_fname_d0exp(out, "ATSCKiseqz", d0e)
implement
emit_ATSCKisneqz(out, d0e) =
  emit_fname_d0exp(out, "ATSCKisneqz", d0e)
//
(* ****** ****** *)
//
implement
emit_ATSCKptriscons(out, d0e) =
  emit_fname_d0exp(out, "ATSCKptriscons", d0e)
implement
emit_ATSCKptrisnull(out, d0e) =
  emit_fname_d0exp(out, "ATSCKptrisnull", d0e)
//
(* ****** ****** *)
//
implement
emit_ATSCKpat_int
  (out, d0e, i0) =
  emit_fname_d0exp2 (out, "ATSCKpat_int", d0e, i0)
implement
emit_ATSCKpat_bool
  (out, d0e, b0) =
  emit_fname_d0exp2 (out, "ATSCKpat_bool", d0e, b0)
implement
emit_ATSCKpat_string
  (out, d0e, s0) =
  emit_fname_d0exp2 (out, "ATSCKpat_string", d0e, s0)
//
(* ****** ****** *)

implement
emit_ATSCKpat_con0
  (out, d0e, ctag) =
{
  val () =
  emit_text (out, "ATSCKpat_con0(")
  val () = (
    emit_d0exp (out, d0e);
    emit_text (out, ", "); emit_int (out, ctag); emit_RPAREN (out)
  ) (* end of [val] *)
} (* end of [emit_ATSCKpat_con0] *)

implement
emit_ATSCKpat_con1
  (out, d0e, ctag) =
{
  val () =
  emit_text (out, "ATSCKpat_con1(")
  val () = (
    emit_d0exp (out, d0e);
    emit_text (out, ", "); emit_int (out, ctag); emit_RPAREN (out)
  ) (* end of [val] *)
} (* end of [emit_ATSCKpat_con1] *)

(* ****** ****** *)
//
implement
emit_tmpvar
  (out, tmp) = emit_i0de (out, tmp)
//
(* ****** ****** *)

implement
emit_d0exp
  (out, d0e0) = let
in
//
case+
d0e0.d0exp_node of
//
| D0Eide (tmp) =>
  {
    val () = emit_tmpvar (out, tmp)
  }
//
| D0Eappid (fid, d0es) =>
  {
    val () = emit_i0de (out, fid)
    val () = emit_LPAREN (out)
    val () = emit_d0explst (out, d0es)
    val () = emit_RPAREN (out)
  }
| D0Eappexp (d0e, d0es) =>
  {
    val () = emit_d0exp (out, d0e)
    val () = emit_LPAREN (out)
    val () = emit_d0explst (out, d0es)
    val () = emit_RPAREN (out)
  }
//
| D0Elist (d0es) =>
  {
    val () = emit_text (out, "D0Elist")
    val () = emit_LPAREN (out)
    val () = emit_d0explst (out, d0es)
    val () = emit_RPAREN (out)
  }
//
| ATSPMVint (int) => emit_PMVint (out, int)
| ATSPMVintrep (int) => emit_PMVintrep (out, int)
//
| ATSPMVbool (tfv) => emit_PMVbool (out, tfv)
//
| ATSPMVfloat (flt) => emit_PMVfloat (out, flt)
//
| ATSPMVstring (str) => emit_PMVstring (out, str)
//
| ATSPMVi0nt (int) => emit_PMVi0nt (out, int)
| ATSPMVf0loat (flt) => emit_PMVf0loat (out, flt)
//
| ATSPMVempty (dummy) => emit_PMVempty (out, 0)
| ATSPMVextval (toklst) => emit_PMVextval (out, toklst)
//
| ATSPMVrefarg0 (d0e) => emit_d0exp (out, d0e)
| ATSPMVrefarg1 (d0e) => emit_d0exp (out, d0e)
//
| ATSPMVfunlab (fl) => emit_PMVfunlab (out, fl)
| ATSPMVcfunlab
    (_(*knd*), fl, d0es) => emit_PMVcfunlab (out, fl, d0es)
  // end of [ATSPMVcfunlab]
//
| ATSPMVcastfn
    (_(*fid*), _(*s0e*), arg) => emit_d0exp (out, arg)
//
| ATSCSTSPmyloc (tok) => emit_CSTSPmyloc (out, tok)
//
| ATSCKiseqz(d0e) => emit_ATSCKiseqz (out, d0e)
| ATSCKisneqz(d0e) => emit_ATSCKisneqz (out, d0e)
| ATSCKptriscons(d0e) => emit_ATSCKptriscons (out, d0e)
| ATSCKptrisnull(d0e) => emit_ATSCKptrisnull (out, d0e)
//
| ATSCKpat_int
    (d0e, int) => emit_ATSCKpat_int (out, d0e, int)
| ATSCKpat_bool
    (d0e, bool) => emit_ATSCKpat_bool (out, d0e, bool)
| ATSCKpat_string
    (d0e, string) => emit_ATSCKpat_bool (out, d0e, string)
//
| ATSCKpat_con0
    (d0e, ctag) => emit_ATSCKpat_con0 (out, d0e, ctag)
| ATSCKpat_con1
    (d0e, ctag) => emit_ATSCKpat_con1 (out, d0e, ctag)
//
| ATSSELcon _ => emit_SELcon (out, d0e0)
| ATSSELrecsin _ => emit_SELrecsin (out, d0e0)
| ATSSELboxrec _ => emit_SELboxrec (out, d0e0)
| ATSSELfltrec _ => emit_text (out, "ATSSELfltrec(...)")
//
| ATSextfcall
    (_fun, _arg) => {
    val () = emit_i0de (out, _fun)
    val () = emit_d0exparg (out, _arg)
  } (* end of [ATSextfcall] *)
| ATSextmcall
    (_obj, _mtd, _arg) => {
//
    val () = emit_d0exp (out, _obj)
    val () = emit_DOT (out)
    val () = emit_d0exp (out, _mtd)
//
    val () = emit_d0exparg (out, _arg)
//
  } (* end of [ATSextmcall] *)
//
| ATSfunclo_fun
    (d0e, _(*arg*), _(*res*)) => emit_d0exp (out, d0e)
| ATSfunclo_clo
    (d0e, _(*arg*), _(*res*)) =>
  (
    emit_d0exp (out, d0e);
    emit_LBRACKET (out); emit_int (out, 0); emit_RBRACKET (out)
  ) (* end of [ATSfunclo_clo] *)
//
end // end of [emit_d0exp]

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

local

fun
loop
(
  out: FILEref, d0es: d0explst, i: int
) : void =
(
case+ d0es of
| list_nil () => ()
| list_cons (d0e, d0es) => let
    val () =
      if i > 0 then emit_text (out, ", ")
    // end of [val]
  in
    emit_d0exp (out, d0e); loop (out, d0es, i+1)
  end // end of [list_cons]
)

in (* in-of-local *)

implement
emit_d0explst (out, d0es) = loop (out, d0es, 0)
implement
emit_d0explst_1 (out, d0es) = loop (out, d0es, 1)

end // end of [local]

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

implement
emit_d0exparg
  (out, d0es) =
{
//
val () = emit_LPAREN (out)
val () = emit_d0explst (out, d0es)
val () = emit_RPAREN (out)
//
} (* end of [emit_d0exparg] *)

(* ****** ****** *)
//
extern
fun
tyrec_labsel
  (tyrec: tyrec, lab: symbol): int
//
implement
tyrec_labsel
  (tyrec, lab) = let
//
fun loop
(
  xs: tyfldlst, i: int
) : int =
(
case+ xs of
| list_cons (x, xs) => let
    val TYFLD (id, s0e) = x.tyfld_node
  in
    if lab = id.i0dex_sym then i else loop (xs, i+1)
  end // end of [list_cons
| list_nil ((*void*)) => ~1(*error*)
)
//
in
  loop (tyrec.tyrec_node, 0)
end // end of [tyrec_labsel]
//
(* ****** ****** *)

implement
emit_SELcon
  (out, d0e) = let
//
val-
ATSSELcon
(d0rec, s0e, id) = d0e.d0exp_node
//
val-S0Eide (name) = s0e.s0exp_node
val-~Some_vt (s0rec) = typedef_search_opt (name)
//
val index = tyrec_labsel (s0rec, id.i0dex_sym)
//
val () =
  emit_d0exp (out, d0rec)
//
val () = emit_LBRACKET (out)
val () = emit_int (out, index)
val () = emit_RBRACKET (out)
//
in
  // nothing
end // end of [emit_SELcon]

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

implement
emit_SELrecsin
  (out, d0e) = let
//
val-
ATSSELrecsin
(d0rec, s0e, id) = d0e.d0exp_node
//
in
  emit_d0exp (out, d0rec)
end // end of [emit_SELrecsin]

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

implement
emit_SELboxrec
  (out, d0e) = let
//
val-
ATSSELboxrec
(d0rec, s0e, id) = d0e.d0exp_node
//
val-S0Eide (name) = s0e.s0exp_node
val-~Some_vt (s0rec) = typedef_search_opt (name)
//
val index = tyrec_labsel (s0rec, id.i0dex_sym)
//
val () =
  emit_d0exp (out, d0rec)
//
val () = emit_LBRACKET (out)
val () = emit_int (out, index)
val () = emit_RBRACKET (out)
//
in
  // nothing
end // end of [emit_SELboxrec]

(* ****** ****** *)
//
implement
emit_COMMENT_line
  (out, tok) = let
//
val-
T_COMMENT_line
  (str) = tok.token_node
//
in
  emit_text (out, str)
end // end of [emit_COMMENT_line]
//
implement
emit_COMMENT_block
  (out, tok) = let
//
val-
T_COMMENT_block
  (str) = tok.token_node
//
in
  emit_text (out, str)
end // end of [emit_COMMENT_block]
//
(* ****** ****** *)

local

fun
aux0_arglst
(
  out: FILEref
, s0es: s0explst
, n0: int, i: int
) : void =
(
case+ s0es of
| list_nil () => ()
| list_cons
    (s0e, s0es) => let
    val () =
    if n0+i > 0 then emit_text (out, ", ")
    val () =
    (
      emit_text (out, "arg"); emit_int (out, i)
    ) (* end of [val] *)
  in
    aux0_arglst (out, s0es, n0, i+1)
  end // end of [list_cons]
) (* end of [aux0_arglst] *)

fun
aux0_envlst
(
  out: FILEref
, s0es: s0explst
, n0: int, i: int
) : void =
(
case+ s0es of
| list_nil () => ()
| list_cons
    (s0e, s0es) => let
    val () =
    if n0+i > 0 then emit_text (out, ", ")
    val () =
    (
      emit_text (out, "env"); emit_int (out, i)
    ) (* end of [val] *)
  in
    aux0_envlst (out, s0es, n0, i+1)
  end // end of [list_cons]
) (* end of [aux0_envlst] *)

fun
aux1_envlst
(
  out: FILEref
, s0es: s0explst, i: int
) : int =
(
case+ s0es of
| list_nil
    ((*void*)) => (i)
| list_cons
    (s0e, s0es) => let
    val () =
    if i > 0
      then emit_text (out, ", ")
    // end of [if]
    val () =
    (
      emit_text (out, "cenv");
      emit_LBRACKET (out); emit_int (out, i+1); emit_RBRACKET (out)
    ) (* end of [val] *)
  in
    aux1_envlst (out, s0es, i+1)
  end // end of [list_cons]
) (* end of [aux1_envlst] *)

in (* in-of-local *)

implement
emit_closurerize
(
  out, fl, env, arg, res
) = let
//
val-S0Elist(s0es_env) = env.s0exp_node
val-S0Elist(s0es_arg) = arg.s0exp_node
//
val () = emit_ENDL (out)
//
val () =
emit_text (out, "function\n")
val () = emit_label (out, fl)
val () =
emit_text (out, "__closurerize(")
val () = aux0_envlst (out, s0es_env, 0, 0)
val ((*closing*)) = emit_text (out, ")\n")
//
val ((*opening*)) = emit_text (out, "{\n")
//
val () = emit_nspc (out, 2)
val () = emit_text (out, "return [")
val () = emit_text (out, "function(")
//
val () = emit_text (out, "cenv")
val () = aux0_arglst (out, s0es_arg, 1, 0)
//
val () = emit_text (out, ") { return ")
//
val () = emit_label (out, fl)
val () = emit_LPAREN (out)
val n0 = aux1_envlst (out, s0es_env, 0)
val () = aux0_arglst (out, s0es_arg, n0, 0)
val () = emit_RPAREN (out)
//
val ((*closing*)) = emit_text (out, "; }")
//
val () = aux0_envlst (out, s0es_env, 1, 0)
val ((*closing*)) = emit_text (out, "];\n}\n")
//
val ((*flushing*)) = emit_newline (out)
//
in
  // nothing
end // end of [emit_closurerize]

end // end of [local]

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

(* end of [atscc2js_emit.dats] *)

(* ****** ****** *)
//
// Atscc2js:
// from ATS to JavaScript
//
(* ****** ****** *)
//
// HX-2014-08-20: start
// HX-2015-05-21: restructure
//
(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
#define
CATSPARSEMIT_targetloc "./.CATS-parsemit"
//
(* ****** ****** *)
//
staload "{$CATSPARSEMIT}/catsparse.sats"
//
staload "{$CATSPARSEMIT}/catsparse_syntax.sats"
//
staload "{$CATSPARSEMIT}/catsparse_emit.sats"
//
staload "{$CATSPARSEMIT}/catsparse_typedef.sats"
//
(* ****** ****** *)

local

staload
TM = "libc/SATS/time.sats"
stadef time_t = $TM.time_t

in (* in-of-local *)

implement
emit_time_stamp (out) = let
//
var tm: time_t
val () = tm := $TM.time_get ()
val (pfopt | p_tm) = $TM.localtime (tm)
//
val () = emit_text (out, "/*\n");
val () = emit_text (out, "**\n");
val () = emit_text (out, "** The JavaScript code is generated by atscc2js\n")
val () = emit_text (out, "** The starting compilation time is: ")
//
val () =
if
p_tm > 0
then let
  prval Some_v @(pf1, fpf1) = pfopt
  val tm_min = $TM.tm_get_min (!p_tm)
  val tm_hour = $TM.tm_get_hour (!p_tm)
  val tm_mday = $TM.tm_get_mday (!p_tm)
  val tm_mon = 1 + $TM.tm_get_mon (!p_tm)
  val tm_year = 1900 + $TM.tm_get_year (!p_tm)
  prval () = fpf1 (pf1)
in
  $extfcall
  (
    void
  , "fprintf"
  , out, "%i-%i-%i: %2ih:%2im\n", tm_year, tm_mon, tm_mday, tm_hour, tm_min
  )
end // end of [then]
else let
  prval None_v () = pfopt
in
  emit_text (out, "**TIME-ERROR**\n")
end // end of [else]
//
val () = emit_text (out, "**\n")
val () = emit_text (out, "*/\n")
//
in
  // emit_newline (out)
end // end of [emit_time_stamp]

end // end of [local]

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

implement
emit_PMVint
  (out, tok) = let
//
val-T_INT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVint]
//
implement
emit_PMVintrep
  (out, tok) = let
//
val-T_INT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVintrep]
//
(* ****** ****** *)

implement
emit_PMVbool
  (out, tfv) =
(
  emit_text (out, if tfv then "true" else "false")
) (* end of [emit_PMVbool] *)

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

implement
emit_PMVstring
  (out, tok) = let
//
val-T_STRING(rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVstring]

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

implement
emit_PMVfloat
  (out, tok) = let
//
val-T_FLOAT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVfloat]

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

implement
emit_PMVi0nt
  (out, tok) = let
//
val-T_INT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVi0nt]

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

implement
emit_PMVf0loat
  (out, tok) = let
//
val-T_FLOAT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVf0loat]

(* ****** ****** *)
//
implement
emit_PMVempty
  (out, _) = emit_text (out, "null")
//
implement
emit_PMVextval
  (out, toks) = emit_tokenlst (out, toks)
//
(* ****** ****** *)
//
implement
emit_PMVfunlab
  (out, flab) = emit_label (out, flab)
//
(* ****** ****** *)

implement
emit_PMVcfunlab
  (out, fl, d0es) =
{
//
val () =
  emit_label (out, fl)
val () =
  emit_text (out, "__closurerize")
//
val () = emit_LPAREN (out)
val () = emit_d0explst (out, d0es)
val () = emit_RPAREN (out)
//
} (* end of [emit_PMVcfunlab] *)

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

implement
emit_CSTSPmyloc
  (out, tok) = let
//
val-T_STRING(rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_CSTSPmyloc]

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

implement
emit_ATSCKiseqz
  (out, d0e) =
{
//
val () = emit_text (out, "ATSCKiseqz(")
val () = (emit_d0exp (out, d0e); emit_RPAREN (out))
//
} (* end of [emit_ATSCKiseqz] *)

implement
emit_ATSCKisneqz
  (out, d0e) =
{
//
val () = emit_text (out, "ATSCKisneqz(")
val () = (emit_d0exp (out, d0e); emit_RPAREN (out))
//
} (* end of [emit_ATSCKisneqz] *)

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

implement
emit_ATSCKptriscons
  (out, d0e) =
{
//
val () = emit_text (out, "ATSCKptriscons(")
val () = (emit_d0exp (out, d0e); emit_RPAREN (out))
//
} (* end of [emit_ATSCKptriscons] *)

implement
emit_ATSCKptrisnull
  (out, d0e) =
{
//
val () = emit_text (out, "ATSCKptrisnull(")
val () = (emit_d0exp (out, d0e); emit_RPAREN (out))
//
} (* end of [emit_ATSCKptrisnull] *)

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

implement
emit_ATSCKpat_int
  (out, d0e, i0) =
{
  val () =
  emit_text (out, "ATSCKpat_int(")
  val () = (
    emit_d0exp (out, d0e);
    emit_text (out, ", "); emit_d0exp (out, i0); emit_RPAREN (out)
  ) (* end of [val] *)
} (* end of [emit_ATSCKpat_int] *)

implement
emit_ATSCKpat_bool
  (out, d0e, b0) =
{
  val () =
  emit_text (out, "ATSCKpat_bool(")
  val () = (
    emit_d0exp (out, d0e);
    emit_text (out, ", "); emit_d0exp (out, b0); emit_RPAREN (out)
  ) (* end of [val] *)
} (* end of [emit_ATSCKpat_bool] *)

implement
emit_ATSCKpat_string
  (out, d0e, s0) =
{
  val () =
  emit_text (out, "ATSCKpat_string(")
  val () = (
    emit_d0exp (out, d0e);
    emit_text (out, ", "); emit_d0exp (out, s0); emit_RPAREN (out)
  ) (* end of [val] *)
} (* end of [emit_ATSCKpat_string] *)

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

implement
emit_ATSCKpat_con0
  (out, d0e, ctag) =
{
  val () =
  emit_text (out, "ATSCKpat_con0(")
  val () = (
    emit_d0exp (out, d0e);
    emit_text (out, ", "); emit_int (out, ctag); emit_RPAREN (out)
  ) (* end of [val] *)
} (* end of [emit_ATSCKpat_con0] *)

implement
emit_ATSCKpat_con1
  (out, d0e, ctag) =
{
  val () =
  emit_text (out, "ATSCKpat_con1(")
  val () = (
    emit_d0exp (out, d0e);
    emit_text (out, ", "); emit_int (out, ctag); emit_RPAREN (out)
  ) (* end of [val] *)
} (* end of [emit_ATSCKpat_con1] *)

(* ****** ****** *)
//
implement
emit_tmpvar
  (out, tmp) = emit_i0de (out, tmp)
//
(* ****** ****** *)

implement
emit_d0exp
  (out, d0e0) = let
in
//
case+
d0e0.d0exp_node of
//
| D0Eide (tmp) =>
  {
    val () = emit_tmpvar (out, tmp)
  }
//
| D0Eappid (fid, d0es) =>
  {
    val () = emit_i0de (out, fid)
    val () = emit_LPAREN (out)
    val () = emit_d0explst (out, d0es)
    val () = emit_RPAREN (out)
  }
| D0Eappexp (d0e, d0es) =>
  {
    val () = emit_d0exp (out, d0e)
    val () = emit_LPAREN (out)
    val () = emit_d0explst (out, d0es)
    val () = emit_RPAREN (out)
  }
//
| D0Elist (d0es) =>
  {
    val () = emit_text (out, "D0Elist")
    val () = emit_LPAREN (out)
    val () = emit_d0explst (out, d0es)
    val () = emit_RPAREN (out)
  }
//
| ATSPMVint (int) => emit_PMVint (out, int)
| ATSPMVintrep (int) => emit_PMVintrep (out, int)
//
| ATSPMVbool (tfv) => emit_PMVbool (out, tfv)
//
| ATSPMVfloat (flt) => emit_PMVfloat (out, flt)
//
| ATSPMVstring (str) => emit_PMVstring (out, str)
//
| ATSPMVi0nt (int) => emit_PMVi0nt (out, int)
| ATSPMVf0loat (flt) => emit_PMVf0loat (out, flt)
//
| ATSPMVempty (dummy) => emit_PMVempty (out, 0)
| ATSPMVextval (toklst) => emit_PMVextval (out, toklst)
//
| ATSPMVrefarg0 (d0e) => emit_d0exp (out, d0e)
| ATSPMVrefarg1 (d0e) => emit_d0exp (out, d0e)
//
| ATSPMVfunlab (fl) => emit_PMVfunlab (out, fl)
| ATSPMVcfunlab
    (_(*knd*), fl, d0es) => emit_PMVcfunlab (out, fl, d0es)
  // end of [ATSPMVcfunlab]
//
| ATSPMVcastfn
    (_(*fid*), _(*s0e*), arg) => emit_d0exp (out, arg)
//
| ATSCSTSPmyloc (tok) => emit_CSTSPmyloc (out, tok)
//
| ATSCKiseqz(d0e) => emit_ATSCKiseqz (out, d0e)
| ATSCKisneqz(d0e) => emit_ATSCKisneqz (out, d0e)
| ATSCKptriscons(d0e) => emit_ATSCKptriscons (out, d0e)
| ATSCKptrisnull(d0e) => emit_ATSCKptrisnull (out, d0e)
//
| ATSCKpat_int
    (d0e, int) => emit_ATSCKpat_int (out, d0e, int)
| ATSCKpat_bool
    (d0e, bool) => emit_ATSCKpat_bool (out, d0e, bool)
| ATSCKpat_string
    (d0e, string) => emit_ATSCKpat_bool (out, d0e, string)
//
| ATSCKpat_con0
    (d0e, ctag) => emit_ATSCKpat_con0 (out, d0e, ctag)
| ATSCKpat_con1
    (d0e, ctag) => emit_ATSCKpat_con1 (out, d0e, ctag)
//
| ATSSELcon _ => emit_SELcon (out, d0e0)
| ATSSELrecsin _ => emit_SELrecsin (out, d0e0)
| ATSSELboxrec _ => emit_SELboxrec (out, d0e0)
| ATSSELfltrec _ => emit_text (out, "ATSSELfltrec(...)")
//
| ATSextfcall
    (_fun, _arg) => {
    val () = emit_i0de (out, _fun)
    val () = emit_d0exparg (out, _arg)
  } (* end of [ATSextfcall] *)
| ATSextmcall
    (_obj, _mtd, _arg) => {
//
    val () = emit_d0exp (out, _obj)
    val () = emit_DOT (out)
    val () = emit_d0exp (out, _mtd)
//
    val () = emit_d0exparg (out, _arg)
//
  } (* end of [ATSextmcall] *)
//
| ATSfunclo_fun
    (d0e, _(*arg*), _(*res*)) => emit_d0exp (out, d0e)
| ATSfunclo_clo
    (d0e, _(*arg*), _(*res*)) =>
  (
    emit_d0exp (out, d0e);
    emit_LBRACKET (out); emit_int (out, 0); emit_RBRACKET (out)
  ) (* end of [ATSfunclo_clo] *)
//
end // end of [emit_d0exp]

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

local

fun
loop
(
  out: FILEref, d0es: d0explst, i: int
) : void =
(
case+ d0es of
| list_nil () => ()
| list_cons (d0e, d0es) => let
    val () =
      if i > 0 then emit_text (out, ", ")
    // end of [val]
  in
    emit_d0exp (out, d0e); loop (out, d0es, i+1)
  end // end of [list_cons]
)

in (* in-of-local *)

implement
emit_d0explst (out, d0es) = loop (out, d0es, 0)
implement
emit_d0explst_1 (out, d0es) = loop (out, d0es, 1)

end // end of [local]

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

implement
emit_d0exparg
  (out, d0es) =
{
//
val () = emit_LPAREN (out)
val () = emit_d0explst (out, d0es)
val () = emit_RPAREN (out)
//
} (* end of [emit_d0exparg] *)

(* ****** ****** *)
//
extern
fun
tyrec_labsel
  (tyrec: tyrec, lab: symbol): int
//
implement
tyrec_labsel
  (tyrec, lab) = let
//
fun loop
(
  xs: tyfldlst, i: int
) : int =
(
case+ xs of
| list_cons (x, xs) => let
    val TYFLD (id, s0e) = x.tyfld_node
  in
    if lab = id.i0dex_sym then i else loop (xs, i+1)
  end // end of [list_cons
| list_nil ((*void*)) => ~1(*error*)
)
//
in
  loop (tyrec.tyrec_node, 0)
end // end of [tyrec_labsel]
//
(* ****** ****** *)

implement
emit_SELcon
  (out, d0e) = let
//
val-
ATSSELcon
(d0rec, s0e, id) = d0e.d0exp_node
//
val-S0Eide (name) = s0e.s0exp_node
val-~Some_vt (s0rec) = typedef_search_opt (name)
//
val index = tyrec_labsel (s0rec, id.i0dex_sym)
//
val () =
  emit_d0exp (out, d0rec)
//
val () = emit_LBRACKET (out)
val () = emit_int (out, index)
val () = emit_RBRACKET (out)
//
in
  // nothing
end // end of [emit_SELcon]

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

implement
emit_SELrecsin
  (out, d0e) = let
//
val-
ATSSELrecsin
(d0rec, s0e, id) = d0e.d0exp_node
//
in
  emit_d0exp (out, d0rec)
end // end of [emit_SELrecsin]

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

implement
emit_SELboxrec
  (out, d0e) = let
//
val-
ATSSELboxrec
(d0rec, s0e, id) = d0e.d0exp_node
//
val-S0Eide (name) = s0e.s0exp_node
val-~Some_vt (s0rec) = typedef_search_opt (name)
//
val index = tyrec_labsel (s0rec, id.i0dex_sym)
//
val () =
  emit_d0exp (out, d0rec)
//
val () = emit_LBRACKET (out)
val () = emit_int (out, index)
val () = emit_RBRACKET (out)
//
in
  // nothing
end // end of [emit_SELboxrec]

(* ****** ****** *)
//
implement
emit_COMMENT_line
  (out, tok) = let
//
val-
T_COMMENT_line
  (str) = tok.token_node
//
in
  emit_text (out, str)
end // end of [emit_COMMENT_line]
//
implement
emit_COMMENT_block
  (out, tok) = let
//
val-
T_COMMENT_block
  (str) = tok.token_node
//
in
  emit_text (out, str)
end // end of [emit_COMMENT_block]
//
(* ****** ****** *)

local

fun
aux0_arglst
(
  out: FILEref
, s0es: s0explst
, n0: int, i: int
) : void =
(
case+ s0es of
| list_nil () => ()
| list_cons
    (s0e, s0es) => let
    val () =
    if n0+i > 0 then emit_text (out, ", ")
    val () =
    (
      emit_text (out, "arg"); emit_int (out, i)
    ) (* end of [val] *)
  in
    aux0_arglst (out, s0es, n0, i+1)
  end // end of [list_cons]
) (* end of [aux0_arglst] *)

fun
aux0_envlst
(
  out: FILEref
, s0es: s0explst
, n0: int, i: int
) : void =
(
case+ s0es of
| list_nil () => ()
| list_cons
    (s0e, s0es) => let
    val () =
    if n0+i > 0 then emit_text (out, ", ")
    val () =
    (
      emit_text (out, "env"); emit_int (out, i)
    ) (* end of [val] *)
  in
    aux0_envlst (out, s0es, n0, i+1)
  end // end of [list_cons]
) (* end of [aux0_envlst] *)

fun
aux1_envlst
(
  out: FILEref
, s0es: s0explst, i: int
) : int =
(
case+ s0es of
| list_nil
    ((*void*)) => (i)
| list_cons
    (s0e, s0es) => let
    val () =
    if i > 0
      then emit_text (out, ", ")
    // end of [if]
    val () =
    (
      emit_text (out, "cenv");
      emit_LBRACKET (out); emit_int (out, i+1); emit_RBRACKET (out)
    ) (* end of [val] *)
  in
    aux1_envlst (out, s0es, i+1)
  end // end of [list_cons]
) (* end of [aux1_envlst] *)

in (* in-of-local *)

implement
emit_closurerize
(
  out, fl, env, arg, res
) = let
//
val-S0Elist(s0es_env) = env.s0exp_node
val-S0Elist(s0es_arg) = arg.s0exp_node
//
val () = emit_ENDL (out)
//
val () =
emit_text (out, "function\n")
val () = emit_label (out, fl)
val () =
emit_text (out, "__closurerize(")
val () = aux0_envlst (out, s0es_env, 0, 0)
val ((*closing*)) = emit_text (out, ")\n")
//
val ((*opening*)) = emit_text (out, "{\n")
//
val () = emit_nspc (out, 2)
val () = emit_text (out, "return [")
val () = emit_text (out, "function(")
//
val () = emit_text (out, "cenv")
val () = aux0_arglst (out, s0es_arg, 1, 0)
//
val () = emit_text (out, ") { return ")
//
val () = emit_label (out, fl)
val () = emit_LPAREN (out)
val n0 = aux1_envlst (out, s0es_env, 0)
val () = aux0_arglst (out, s0es_arg, n0, 0)
val () = emit_RPAREN (out)
//
val ((*closing*)) = emit_text (out, "; }")
//
val () = aux0_envlst (out, s0es_env, 1, 0)
val ((*closing*)) = emit_text (out, "];\n}\n")
//
val ((*flushing*)) = emit_newline (out)
//
in
  // nothing
end // end of [emit_closurerize]

end // end of [local]

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

(* end of [atscc2js_emit.dats] *)


updating z3 location

updating z3 location

(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2011-2013 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of the GNU LESSER GENERAL PUBLIC LICENSE as published by the
** Free Software Foundation; either version 2.1, or (at your option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Start Time: April, 2013
**
** Author: William Blair
** Authoremail: wdblair AT bu DOT edu
**
** Author: Hongwei Xi
** Authoremail: gmhwxi AT gmail DOT com
*)

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

%{#
#include "libats-/wdblair/SMT/Z3/CATS/z3.cats"
%} // end of [%{#]

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

#define ATS_PACKNAME "ATSCNTRB.libats-wdblair.Z3"
#define ATS_STALOADFLAG 0 // no static loading at run-time
#define ATS_EXTERN_PREFIX "atscntrb_" // prefix for external names

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

#define
ATSCNTRB_SML_Z3_Z3_HEADER
#include "./z3_header.sats"

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

(*
Z3_config Z3_mk_config ()
Create a configuration.
*)
fun Z3_mk_config (): Z3_config = "mac#%"

(*
void Z3_del_config (__in Z3_config c)
Delete the given configuration object.
*)
fun Z3_del_config (cfg: Z3_config): void = "mac#%"

(*
void Z3_set_param_value
(
  __in Z3_config c, __in Z3_string param_id, __in Z3_string param_value
)
Set a configuration parameter.
*)
fun Z3_set_param_value
(
  cfg: !Z3_config, p_id: Z3_string, p_val: Z3_string
) : void = "mac#%" // end of [Z3_set_param_value]

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

(*
Z3_context Z3_mk_context (__in Z3_config c)
Create a context using the given configuration.
*)
(*
fun Z3_mk_context (cfg: !Z3_config): Z3_context = "mac#%"
*)

(*
Z3_context Z3_mk_context_rc (__in Z3_config c)
Create a context using the given configuration. This function is similar to
Z3_mk_context. However, in the context returned by this function, the user
is responsible for managing Z3_ast reference counters. Managing reference
counters is a burden and error-prone, but allows the user to use the memory
more efficiently. The user must invoke Z3_inc_ref for any Z3_ast returned
by Z3, and Z3_dec_ref whenever the Z3_ast is not needed anymore. This idiom
is similar to the one used in BDD (binary decision diagrams) packages such
as CUDD.
*)

fun Z3_mk_context_rc (cfg: !Z3_config): Z3_context = "mac#%"

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

(*
void
Z3_del_context (__in Z3_context c)
Delete the given logical context.
*)
fun Z3_del_context (ctx: Z3_context): void = "mac#%"

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

(*
void Z3_inc_ref (__in Z3_context c, __in Z3_ast a)
Increment the reference counter of the given AST. The context c should
have been created using Z3_mk_context_rc. This function is a NOOP if c
was created using Z3_mk_context.
*)
fun Z3_inc_ref{l:addr}
  (ctx: !Z3_context, a: !Z3_ast l): Z3_ast (l) = "mac#%"
// end of [Z3_inc_ref]

(*
void
Z3_dec_ref (__in Z3_context c, __in Z3_ast a)
Decrement the reference counter of the given AST. The context c should
have been created using Z3_mk_context_rc. This function is a NOOP if c
was created using Z3_mk_context.
*)
fun Z3_dec_ref (ctx: !Z3_context, a: Z3_ast): void = "mac#%"

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

(*
Z3_bool
Z3_get_param_value
(
  __in Z3_context c
, __in Z3_string param_id, __out Z3_string_ptr param_value
)
*)
fun Z3_get_param_value
(
  ctx: !Z3_context, p_id: Z3_string, p_val: &ptr? >> opt (Z3_string, b)
) : #[b:bool] bool (b) = "mac#%"

(*
void
Z3_update_param_value
(__in Z3_context c, __in Z3_string param_id, __in Z3_string param_value)
*)
fun Z3_update_param_value
  (ctx: !Z3_context, p_id: Z3_string, p_val: Z3_string): void = "mac#%"
// end of [Z3_update_param_value]

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

(*
void
Z3_interrupt (__in Z3_context c)
Interrupt the execution of a Z3 procedure. This procedure can be used to
interrupt: solvers, simplifiers and tactics.
*)
fun Z3_interrupt (ctx: !Z3_context): void = "mac#%"

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

#include "./z3_accessor.sats"

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

#include "./z3_params.sats"
#include "./z3_params_descrs.sats"

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

#include "./z3_symbol.sats"

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

#include "./z3_sort.sats"

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

#include "./z3_constapp.sats"

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

#include "./z3_propeq.sats"

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

#include "./z3_arithmetic.sats"

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

#include "./z3_bitvector.sats"

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

#include "./z3_numerals.sats"

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

#include "./z3_array.sats"

(*
#include "./z3_quantifier.sats"
*)

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

#include "./z3_accessor.sats"
#include "./z3_modifier.sats"

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

#include "./z3_model.sats"

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

#include "./z3_parser.sats"

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

(*
#include "./z3_interlog.sats"
*)

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

#include "./z3_quantifier.sats"

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

#include "./z3_stringconv.sats"

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

(*
#include "./z3_parserint.sats"
#include "./z3_errhandle.sats"
*)

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

#include "./z3_fixedpoint.sats"

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

(*
#include "./z3_ast_map"
#include "./z3_ast_vector"
*)

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

#include "./z3_goal.sats"

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

#include "./z3_tactic_probe.sats"

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

#include "./z3_solver.sats"

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

#include "./z3_stats.sats"

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

(* end of [z3.sats] *)

(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2011-2013 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of the GNU LESSER GENERAL PUBLIC LICENSE as published by the
** Free Software Foundation; either version 2.1, or (at your option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Start Time: April, 2013
**
** Author: William Blair
** Authoremail: wdblair AT bu DOT edu
**
** Author: Hongwei Xi
** Authoremail: gmhwxi AT gmail DOT com
*)

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

%{#
#include "contrib/libats-/wdblair/SMT/Z3/CATS/z3.cats"
%} // end of [%{#]

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

#define ATS_PACKNAME "ATSCNTRB.libats-wdblair.Z3"
#define ATS_STALOADFLAG 0 // no static loading at run-time
#define ATS_EXTERN_PREFIX "atscntrb_" // prefix for external names

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

#define
ATSCNTRB_SML_Z3_Z3_HEADER
#include "./z3_header.sats"

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

(*
Z3_config Z3_mk_config ()
Create a configuration.
*)
fun Z3_mk_config (): Z3_config = "mac#%"

(*
void Z3_del_config (__in Z3_config c)
Delete the given configuration object.
*)
fun Z3_del_config (cfg: Z3_config): void = "mac#%"

(*
void Z3_set_param_value
(
  __in Z3_config c, __in Z3_string param_id, __in Z3_string param_value
)
Set a configuration parameter.
*)
fun Z3_set_param_value
(
  cfg: !Z3_config, p_id: Z3_string, p_val: Z3_string
) : void = "mac#%" // end of [Z3_set_param_value]

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

(*
Z3_context Z3_mk_context (__in Z3_config c)
Create a context using the given configuration.
*)
(*
fun Z3_mk_context (cfg: !Z3_config): Z3_context = "mac#%"
*)

(*
Z3_context Z3_mk_context_rc (__in Z3_config c)
Create a context using the given configuration. This function is similar to
Z3_mk_context. However, in the context returned by this function, the user
is responsible for managing Z3_ast reference counters. Managing reference
counters is a burden and error-prone, but allows the user to use the memory
more efficiently. The user must invoke Z3_inc_ref for any Z3_ast returned
by Z3, and Z3_dec_ref whenever the Z3_ast is not needed anymore. This idiom
is similar to the one used in BDD (binary decision diagrams) packages such
as CUDD.
*)

fun Z3_mk_context_rc (cfg: !Z3_config): Z3_context = "mac#%"

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

(*
void
Z3_del_context (__in Z3_context c)
Delete the given logical context.
*)
fun Z3_del_context (ctx: Z3_context): void = "mac#%"

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

(*
void Z3_inc_ref (__in Z3_context c, __in Z3_ast a)
Increment the reference counter of the given AST. The context c should
have been created using Z3_mk_context_rc. This function is a NOOP if c
was created using Z3_mk_context.
*)
fun Z3_inc_ref{l:addr}
  (ctx: !Z3_context, a: !Z3_ast l): Z3_ast (l) = "mac#%"
// end of [Z3_inc_ref]

(*
void
Z3_dec_ref (__in Z3_context c, __in Z3_ast a)
Decrement the reference counter of the given AST. The context c should
have been created using Z3_mk_context_rc. This function is a NOOP if c
was created using Z3_mk_context.
*)
fun Z3_dec_ref (ctx: !Z3_context, a: Z3_ast): void = "mac#%"

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

(*
Z3_bool
Z3_get_param_value
(
  __in Z3_context c
, __in Z3_string param_id, __out Z3_string_ptr param_value
)
*)
fun Z3_get_param_value
(
  ctx: !Z3_context, p_id: Z3_string, p_val: &ptr? >> opt (Z3_string, b)
) : #[b:bool] bool (b) = "mac#%"

(*
void
Z3_update_param_value
(__in Z3_context c, __in Z3_string param_id, __in Z3_string param_value)
*)
fun Z3_update_param_value
  (ctx: !Z3_context, p_id: Z3_string, p_val: Z3_string): void = "mac#%"
// end of [Z3_update_param_value]

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

(*
void
Z3_interrupt (__in Z3_context c)
Interrupt the execution of a Z3 procedure. This procedure can be used to
interrupt: solvers, simplifiers and tactics.
*)
fun Z3_interrupt (ctx: !Z3_context): void = "mac#%"

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

#include "./z3_accessor.sats"

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

#include "./z3_params.sats"
#include "./z3_params_descrs.sats"

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

#include "./z3_symbol.sats"

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

#include "./z3_sort.sats"

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

#include "./z3_constapp.sats"

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

#include "./z3_propeq.sats"

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

#include "./z3_arithmetic.sats"

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

#include "./z3_bitvector.sats"

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

#include "./z3_numerals.sats"

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

#include "./z3_array.sats"

(*
#include "./z3_quantifier.sats"
*)

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

#include "./z3_accessor.sats"
#include "./z3_modifier.sats"

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

#include "./z3_model.sats"

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

#include "./z3_parser.sats"

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

(*
#include "./z3_interlog.sats"
*)

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

#include "./z3_quantifier.sats"

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

#include "./z3_stringconv.sats"

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

(*
#include "./z3_parserint.sats"
#include "./z3_errhandle.sats"
*)

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

#include "./z3_fixedpoint.sats"

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

(*
#include "./z3_ast_map"
#include "./z3_ast_vector"
*)

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

#include "./z3_goal.sats"

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

#include "./z3_tactic_probe.sats"

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

#include "./z3_solver.sats"

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

#include "./z3_stats.sats"

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

(* end of [z3.sats] *)