Updating: merging

Updating: merging

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

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

#define ATS_DYNLOADFLAG 0

(* ****** ****** *)
//
// HX-2014-08:
// prefix for external names
//
#define
ATS_EXTERN_PREFIX "ats2jspre_ML_"
#define
ATS_STATIC_PREFIX "_ats2jspre_ML_list0_"
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
staload "./../../basics_js.sats"
//
(* ****** ****** *)
//
staload "./../../SATS/integer.sats"
//
(* ****** ****** *)
//
staload "./../../SATS/print.sats"
staload "./../../SATS/filebas.sats"
//
(* ****** ****** *)
//
staload "./../../SATS/list.sats"
staload "./../../SATS/ML/list0.sats"
//
(* ****** ****** *)
//
#include "{$LIBATSCC}/DATS/ML/list0.dats"
//
(* ****** ****** *)
//
implement
list0_head_exn
  {a}(xs) =
(
case+ xs of
| list0_cons
    (x, _) => (x)
  // list0_cons
| list0_nil() =>
  (
    $extfcall(a, "ats2jspre_ListSubscriptExn_throw")
  ) (* list0_nil *)
) (* end of [list0_head_exn] *)
//
(* ****** ****** *)
//
implement
list0_tail_exn
  {a}(xs) =
(
case+ xs of
| list0_cons
    (_, xs) => (xs)
  // list0_cons
| list0_nil() =>
  (
    $extfcall
      (list0(a), "ats2jspre_ListSubscriptExn_throw")
    // $extfcall
  ) (* list0_nil *)
) (* end of [list0_tail_exn] *)
//
(* ****** ****** *)

implement
list0_get_at_exn
  {a}(xs, n) =
(
  case+ xs of
  | list0_nil() =>
    (
      $extfcall(a, "ats2jspre_ListSubscriptExn_throw")
    ) (* list0_nil *)
  | list0_cons(x, xs) =>
      if n > 0 then list0_get_at_exn(xs, n-1) else (x)
    // end of [list0_cons]
) (* end of [list0_get_at_exn] *)
//
(* ****** ****** *)

implement
list0_insert_at_exn
  {a}
(
  xs, i0, x0
) = aux(xs, i0) where
{
//
fun
aux
(
  xs: list0(a), i0: intGte(0)
) : list0(a) =
(
if
i0 > 0
then
(
case+ xs of
| list0_nil() =>
  $extfcall
    (list0(a), "ats2jspre_ListSubscriptExn_throw")
  // (* list0_nil *)
| list0_cons(x, xs) => list0_cons(x, aux(xs, i0-1))
)
else list0_cons(x0, xs)
) (* end of [aux] *)
//
} (* end of [list0_insert_at_exn] *)

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

implement
list0_remove_at_exn
  {a}
(
  xs, i0
) = aux(xs, i0) where
{
//
fun
aux
(
  xs: list0(a), i0: intGte(0)
) : list0(a) =
(
case+ xs of
| list0_nil() =>
  $extfcall
    (list0(a), "ats2jspre_ListSubscriptExn_throw")
  // (* list0_nil *)
| list0_cons(x, xs) =>
  if i0 > 0 then list0_cons(x, aux(xs, i0-1)) else xs
)
//
} (* end of [list0_remove_at_exn] *)

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

(* end of [list0.dats] *)

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

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

#define ATS_DYNLOADFLAG 0

(* ****** ****** *)
//
// HX-2014-08:
// prefix for external names
//
#define
ATS_EXTERN_PREFIX "ats2jspre_ML_"
#define
ATS_STATIC_PREFIX "_ats2jspre_ML_list0_"
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
staload "./../../basics_js.sats"
//
(* ****** ****** *)
//
staload "./../../SATS/integer.sats"
//
(* ****** ****** *)
//
staload "./../../SATS/print.sats"
staload "./../../SATS/filebas.sats"
//
(* ****** ****** *)
//
staload "./../../SATS/list.sats"
staload "./../../SATS/ML/list0.sats"
//
(* ****** ****** *)
//
#include "{$LIBATSCC}/DATS/ML/list0.dats"
//
(* ****** ****** *)
//
implement
list0_head_exn
  {a}(xs) =
(
case+ xs of
| list0_cons
    (x, _) => (x)
  // list0_cons
| list0_nil() =>
  (
    $extfcall(a, "ats2jspre_ListSubscriptExn_throw")
  ) (* list0_nil *)
) (* end of [list0_head_exn] *)
//
(* ****** ****** *)
//
implement
list0_tail_exn
  {a}(xs) =
(
case+ xs of
| list0_cons
    (_, xs) => (xs)
  // list0_cons
| list0_nil() =>
  (
    $extfcall(list0(a), "ats2jspre_ListSubscriptExn_throw")
  ) (* list0_nil *)
) (* end of [list0_tail_exn] *)
//
(* ****** ****** *)

implement
list0_get_at_exn
  {a}(xs, n) =
(
  case+ xs of
  | list0_nil() =>
    (
      $extfcall(a, "ats2jspre_ListSubscriptExn_throw")
    ) (* list0_nil *)
  | list0_cons(x, xs) =>
      if n > 0 then list0_get_at_exn(xs, n-1) else (x)
    // end of [list0_cons]
) (* end of [list0_get_at_exn] *)
//
(* ****** ****** *)

implement
list0_insert_at_exn
  {a}
(
  xs, i0, x0
) = aux(xs, i0) where
{
//
fun
aux
(
  xs: list0(a), i0: intGte(0)
) : list0(a) =
(
if
i0 > 0
then
(
case+ xs of
| list0_nil() =>
  $extfcall
    (list0(a), "ats2jspre_ListSubscriptExn_throw")
  // (* list0_nil *)
| list0_cons(x, xs) => list0_cons(x, aux(xs, i0-1))
)
else list0_cons(x0, xs)
) (* end of [aux] *)
//
} (* end of [list0_insert_at_exn] *)

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

implement
list0_remove_at_exn
  {a}
(
  xs, i0
) = aux(xs, i0) where
{
//
fun
aux
(
  xs: list0(a), i0: intGte(0)
) : list0(a) =
(
case+ xs of
| list0_nil() =>
  $extfcall
    (list0(a), "ats2jspre_ListSubscriptExn_throw")
  // (* list0_nil *)
| list0_cons(x, xs) =>
  if i0 > 0 then list0_cons(x, aux(xs, i0-1)) else xs
)
//
} (* end of [list0_remove_at_exn] *)

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

(* end of [list0.dats] *)


Add printed beep

Add printed beep

(* ****** ****** *)
//
// chip8-loop.dats
// Implementation of functions that handle the main emulation loop.
//
(* ****** ****** *)

#ifndef CHIP8_MAIN
#include "./../staloadall.hats"
#endif

staload STDLIB = "libats/libc/SATS/stdlib.sats"

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

local
  assume opcode_type = '{
    p = byte,
    x = word,
    y = word,
    n = byte,
    kk = byte,
    nnn = word
  }

  val interrupted = ref<bool>(false)

  fun fetch(): word = opc where {
    val b_hi = Mem(w2imem(PC.get()))
    val () = PC.incr(w_0x1)
    val b_lo = Mem(w2imem(PC.get()))
    val () = PC.incr(w_0x1)
    val opc = (b2w(b_hi) lsl 0x8) lor b2w(b_lo)
  }

  fun decode(opc: word): opcode = '{
    p = w2b((opc lsr 0xC) land w_0xF),
    x = (opc lsr 0x8) land w_0xF,
    y = (opc lsr 0x4) land w_0xF,
    n = w2b(opc land w_0xF),
    kk = w2b(opc land w_0xFF),
    nnn = opc land w_0xFFF
  }

  fun execute(opc: opcode): void =
    let
      fun check_p(p: byte): bool = opc.p = p
      fun check_pn(p: byte, n: byte): bool = opc.p = p && opc.n = n
      fun check_pkk(p: byte, kk: byte): bool = opc.p = p && opc.kk = kk
      fun check_pnnn(p: byte, nnn: word): bool = opc.p = p && opc.nnn = nnn
      fun get_Vx(): byte = (V(opc.x)).get()
      fun set_Vx(b: byte): void = (V(opc.x)).set(b)
      fun get_Vy(): byte = (V(opc.y)).get()
      fun set_Vy(b: byte): void = (V(opc.y)).set(b)
      fun set_Vf(test: bool): void =
        if test then (V(w_0xF)).set(b_0x1) else (V(w_0xF)).set(b_0x0)

      overload Vx with get_Vx
      overload Vx with set_Vx
      overload Vy with get_Vy
      overload Vy with set_Vy
      overload Vf with set_Vf
    in
      ifcase
      | check_pkk(b_0x0, i2b(0xE0)) => clear_screen()
      | check_pkk(b_0x0, i2b(0xEE)) => PC.set(stack_pop())
      | check_p(b_0x1) => PC.set(opc.nnn)
      | check_p(b_0x2) => (stack_push(PC.get()); PC.set(opc.nnn))
      | check_p(b_0x3) => if (Vx() = opc.kk) then PC.incr(w_0x2)
      | check_p(b_0x4) => if (Vx() != opc.kk) then PC.incr(w_0x2)
      | check_p(b_0x5) => if (Vx() = Vy()) then PC.incr(w_0x2)
      | check_p(b_0x6) => Vx(opc.kk)
      | check_p(b_0x7) => Vx(Vx() + opc.kk)
      | check_pn(b_0x8, b_0x0) => Vx(Vy())
      | check_pn(b_0x8, b_0x1) => Vx(Vx() lor Vy())
      | check_pn(b_0x8, b_0x2) => Vx(Vx() land Vy())
      | check_pn(b_0x8, b_0x3) => Vx(Vx() lxor Vy())
      | check_pn(b_0x8, b_0x4) => (Vf(Vx() > (b_0xFF - Vy())); Vx(Vx() + Vy()))
      | check_pn(b_0x8, b_0x5) => (Vf(Vx() > Vy()); Vx(Vx() - Vy()))
      | check_pn(b_0x8, b_0x6) => (Vf((Vx() land b_0x1) = b_0x1); Vx(Vx() lsr 1))
      | check_pn(b_0x8, b_0x7) => (Vf(Vy() > Vx()); Vx(Vy() - Vx()))
      | check_pn(b_0x8, b_0xE) => (Vf((Vx() lsr 7) = b_0x1); Vx(Vx() lsl 1))
      | check_pn(b_0x9, b_0x0) => if (Vx() != Vy()) then PC.incr(w_0x2)
      | check_p(b_0xA) => I.set(opc.nnn)
      | check_p(b_0xB) => PC.set(b2w((V(w_0x0)).get()) + opc.nnn)
      | check_p(b_0xC) => Vx(i2b($STDLIB.rand() % 256) land opc.kk)
      | check_p(b_0xD) => draw_y(0) where {
        val () = (V(w_0xF)).set(b_0x0)
        val x = b2i(Vx())
        val y = b2i(Vy())
        val height = b2i(opc.n)

        fun draw_x(row: byte, x_off: natLt(SPR_WIDTH), y_off: int):<cloref1> void =
          if x_off < SPR_WIDTH && x + x_off < SCR_WIDTH then
            let
              val _x = $UN.cast{natLt(SCR_WIDTH)}(x + x_off)
              val _y = $UN.cast{natLt(SCR_HEIGHT)}(y + y_off)
              val pix = (row lsr (SPR_WIDTH - 1 - x_off)) land b_0x1
              val () = if pix = b_0x1 then (
                if Scr(_x, _y) = b_0x1 then (
                  (V(w_0xF)).set(b_0x1);
                  Scr(_x, _y, b_0x0)
                ) else Scr(_x, _y, b_0x1)
              )
            in
              if succ(x_off) < SPR_WIDTH then draw_x(row, succ(x_off), y_off)
            end

        fun draw_y(y_off: int):<cloref1> void = (
          if y_off < height && y + y_off < SCR_HEIGHT then (
            draw_x(Mem($UN.cast{imem}(w2i(I.get()) + y_off)), 0, y_off);
            draw_y(succ(y_off))
          )
        )
      }
      | check_pkk(b_0xE, i2b(0x9E)) =>
        if check_key($UN.cast{nkey}(Vx())) then PC.incr(w_0x2)
      | check_pkk(b_0xE, i2b(0xA1)) =>
        if not(check_key($UN.cast{nkey}(Vx()))) then PC.incr(w_0x2)
      | check_pkk(b_0xF, b_0x7) => Vx(DT.get())
      | check_pkk(b_0xF, b_0xA) => wait_for_key(opc.x)
      | check_pkk(b_0xF, i2b(0x15)) => DT.set(Vx())
      | check_pkk(b_0xF, i2b(0x18)) => (ST.set(Vx()); println!("Beep!"))
      | check_pkk(b_0xF, i2b(0x1E)) => (
          Vf(w2i(I.get()) + b2i(Vx()) > 0xFFF);
          I.set(I.get() + b2w(Vx()))
        )
      | check_pkk(b_0xF, i2b(0x29)) => I.set(b2w(Vx() * b_0x5))
      | check_pkk(b_0xF, i2b(0x33)) => (
          Mem(w2imem(I.get()), Vx() / i2b(100) % i2b(10));
          Mem(w2imem(I.get()), Vx() / i2b(10) % i2b(10));
          Mem(w2imem(I.get()), Vx() % i2b(10))
        )
      | check_pkk(b_0xF, i2b(0x55)) => store(w_0x0, opc.x) where {
          fun store(i: word, n: word): void = (
            Mem(w2imem(I.get() + i), (V(i)).get());
            if (succ(w2i(i)) < NUM_REGS) && (i < n) then store(i + w_0x1, n)
          )
        }
      | check_pkk(b_0xF, i2b(0x65)) => fill(w_0x0, opc.x) where {
          fun fill(i: word, n: word): void = (
            (V(i)).set(Mem(w2imem(I.get() + i)));
            if succ(w2i(i)) < NUM_REGS then if i < n then fill(i + w_0x1, n)
          )
        }
      | _ => $raise UnknownOpcode((b2w(opc.p) lsl 0xC) lor opc.nnn)
    end

  fun exec_insns(): void =
    if has_time() && not(waiting_for_key()) then
      let
        val opc = fetch()
        val opc = decode(opc)
      in
        (execute(opc); exec_insns())
      end

in
  implement quit() = !interrupted := true

  implement game_loop(dpy) =
    let
      val () = exec_insns()
      val () = poll_kb()
      val () = if sync_clock() then update_display(dpy)
    in
      if not !interrupted then game_loop(dpy)
    end
end

(* End of chip8-loop.dats *)

(* ****** ****** *)
//
// chip8-loop.dats
// Implementation of functions that handle the main emulation loop.
//
(* ****** ****** *)

#ifndef CHIP8_MAIN
#include "./../staloadall.hats"
#endif

staload STDLIB = "libats/libc/SATS/stdlib.sats"

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

local
  assume opcode_type = '{
    p = byte,
    x = word,
    y = word,
    n = byte,
    kk = byte,
    nnn = word
  }

  val interrupted = ref<bool>(false)

  fun fetch(): word = opc where {
    val b_hi = Mem(w2imem(PC.get()))
    val () = PC.incr(w_0x1)
    val b_lo = Mem(w2imem(PC.get()))
    val () = PC.incr(w_0x1)
    val opc = (b2w(b_hi) lsl 0x8) lor b2w(b_lo)
  }

  fun decode(opc: word): opcode = '{
    p = w2b((opc lsr 0xC) land w_0xF),
    x = (opc lsr 0x8) land w_0xF,
    y = (opc lsr 0x4) land w_0xF,
    n = w2b(opc land w_0xF),
    kk = w2b(opc land w_0xFF),
    nnn = opc land w_0xFFF
  }

  fun execute(opc: opcode): void =
    let
      fun check_p(p: byte): bool = opc.p = p
      fun check_pn(p: byte, n: byte): bool = opc.p = p && opc.n = n
      fun check_pkk(p: byte, kk: byte): bool = opc.p = p && opc.kk = kk
      fun check_pnnn(p: byte, nnn: word): bool = opc.p = p && opc.nnn = nnn
      fun get_Vx(): byte = (V(opc.x)).get()
      fun set_Vx(b: byte): void = (V(opc.x)).set(b)
      fun get_Vy(): byte = (V(opc.y)).get()
      fun set_Vy(b: byte): void = (V(opc.y)).set(b)
      fun set_Vf(test: bool): void =
        if test then (V(w_0xF)).set(b_0x1) else (V(w_0xF)).set(b_0x0)

      overload Vx with get_Vx
      overload Vx with set_Vx
      overload Vy with get_Vy
      overload Vy with set_Vy
      overload Vf with set_Vf
    in
      ifcase
      | check_pkk(b_0x0, i2b(0xE0)) => clear_screen()
      | check_pkk(b_0x0, i2b(0xEE)) => PC.set(stack_pop())
      | check_p(b_0x1) => PC.set(opc.nnn)
      | check_p(b_0x2) => (stack_push(PC.get()); PC.set(opc.nnn))
      | check_p(b_0x3) => if (Vx() = opc.kk) then PC.incr(w_0x2)
      | check_p(b_0x4) => if (Vx() != opc.kk) then PC.incr(w_0x2)
      | check_p(b_0x5) => if (Vx() = Vy()) then PC.incr(w_0x2)
      | check_p(b_0x6) => Vx(opc.kk)
      | check_p(b_0x7) => Vx(Vx() + opc.kk)
      | check_pn(b_0x8, b_0x0) => Vx(Vy())
      | check_pn(b_0x8, b_0x1) => Vx(Vx() lor Vy())
      | check_pn(b_0x8, b_0x2) => Vx(Vx() land Vy())
      | check_pn(b_0x8, b_0x3) => Vx(Vx() lxor Vy())
      | check_pn(b_0x8, b_0x4) => (Vf(Vx() > (b_0xFF - Vy())); Vx(Vx() + Vy()))
      | check_pn(b_0x8, b_0x5) => (Vf(Vx() > Vy()); Vx(Vx() - Vy()))
      | check_pn(b_0x8, b_0x6) => (Vf((Vx() land b_0x1) = b_0x1); Vx(Vx() lsr 1))
      | check_pn(b_0x8, b_0x7) => (Vf(Vy() > Vx()); Vx(Vy() - Vx()))
      | check_pn(b_0x8, b_0xE) => (Vf((Vx() lsr 7) = b_0x1); Vx(Vx() lsl 1))
      | check_pn(b_0x9, b_0x0) => if (Vx() != Vy()) then PC.incr(w_0x2)
      | check_p(b_0xA) => I.set(opc.nnn)
      | check_p(b_0xB) => PC.set(b2w((V(w_0x0)).get()) + opc.nnn)
      | check_p(b_0xC) => Vx(i2b($STDLIB.rand() % 256) land opc.kk)
      | check_p(b_0xD) => draw_y(0) where {
        val () = (V(w_0xF)).set(b_0x0)
        val x = b2i(Vx())
        val y = b2i(Vy())
        val height = b2i(opc.n)

        fun draw_x(row: byte, x_off: natLt(SPR_WIDTH), y_off: int):<cloref1> void =
          if x_off < SPR_WIDTH && x + x_off < SCR_WIDTH then
            let
              val _x = $UN.cast{natLt(SCR_WIDTH)}(x + x_off)
              val _y = $UN.cast{natLt(SCR_HEIGHT)}(y + y_off)
              val pix = (row lsr (SPR_WIDTH - 1 - x_off)) land b_0x1
              val () = if pix = b_0x1 then (
                if Scr(_x, _y) = b_0x1 then (
                  (V(w_0xF)).set(b_0x1);
                  Scr(_x, _y, b_0x0)
                ) else Scr(_x, _y, b_0x1)
              )
            in
              if succ(x_off) < SPR_WIDTH then draw_x(row, succ(x_off), y_off)
            end

        fun draw_y(y_off: int):<cloref1> void = (
          if y_off < height && y + y_off < SCR_HEIGHT then (
            draw_x(Mem($UN.cast{imem}(w2i(I.get()) + y_off)), 0, y_off);
            draw_y(succ(y_off))
          )
        )
      }
      | check_pkk(b_0xE, i2b(0x9E)) =>
        if check_key($UN.cast{nkey}(Vx())) then PC.incr(w_0x2)
      | check_pkk(b_0xE, i2b(0xA1)) =>
        if not(check_key($UN.cast{nkey}(Vx()))) then PC.incr(w_0x2)
      | check_pkk(b_0xF, b_0x7) => Vx(DT.get())
      | check_pkk(b_0xF, b_0xA) => wait_for_key(opc.x)
      | check_pkk(b_0xF, i2b(0x15)) => DT.set(Vx())
      | check_pkk(b_0xF, i2b(0x18)) => ST.set(Vx())
      | check_pkk(b_0xF, i2b(0x1E)) => (
          Vf(w2i(I.get()) + b2i(Vx()) > 0xFFF);
          I.set(I.get() + b2w(Vx()))
        )
      | check_pkk(b_0xF, i2b(0x29)) => I.set(b2w(Vx() * b_0x5))
      | check_pkk(b_0xF, i2b(0x33)) => (
          Mem(w2imem(I.get()), Vx() / i2b(100) % i2b(10));
          Mem(w2imem(I.get()), Vx() / i2b(10) % i2b(10));
          Mem(w2imem(I.get()), Vx() % i2b(10))
        )
      | check_pkk(b_0xF, i2b(0x55)) => store(w_0x0, opc.x) where {
          fun store(i: word, n: word): void = (
            Mem(w2imem(I.get() + i), (V(i)).get());
            if (succ(w2i(i)) < NUM_REGS) && (i < n) then store(i + w_0x1, n)
          )
        }
      | check_pkk(b_0xF, i2b(0x65)) => fill(w_0x0, opc.x) where {
          fun fill(i: word, n: word): void = (
            (V(i)).set(Mem(w2imem(I.get() + i)));
            if succ(w2i(i)) < NUM_REGS then if i < n then fill(i + w_0x1, n)
          )
        }
      | _ => $raise UnknownOpcode((b2w(opc.p) lsl 0xC) lor opc.nnn)
    end

  fun exec_insns(): void =
    if has_time() && not(waiting_for_key()) then
      let
        val opc = fetch()
        val opc = decode(opc)
      in
        (execute(opc); exec_insns())
      end

in
  implement quit() = !interrupted := true

  implement game_loop(dpy) =
    let
      val () = exec_insns()
      val () = poll_kb()
      val () = if sync_clock() then update_display(dpy)
    in
      if not !interrupted then game_loop(dpy)
    end
end

(* End of chip8-loop.dats *)


Updating: adding a JS version of P1-hwxi

(*
** Project Euler: P1
** See https://projecteuler.net
*)

(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTcom
// Start time: January 13, 2015
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
#include
"{$LIBATSCC2JS}/staloadall.hats"
//
(* ****** ****** *)

staload
"{$LIBATSCC2JS}/SATS/print.sats"

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

#define ATS_MAINATSFLAG 1
#define ATS_DYNLOADNAME "my_dynload"

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

%{
function
atspre_g0int_mod_int(n, p) { return (n%p); }
%} // end of [%{]

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

%{$
//
ats2jspre_the_print_store_clear();
my_dynload();
alert(ats2jspre_the_print_store_join());
//
%} // end of [%{$]

(* ****** ****** *)
//
staload
"{$LIBATSHWXI}/PEULER/PROJECT/P1/P1.sats"
//
(* ****** ****** *)

implement
sum35 (n) = let
//
fun loop
  {n:nat}{t0:int} .<n>.
(
  n: int n, t0: int t0
) : [t:int | t >= t0] (SUM35 (n, t-t0) | int (t)) =
(
  if n > 0 then let
    val (pf3 | r3) = nmod (n, 3)
  in
    if r3 = 0 then let
      val (pf | t) = loop (n-1, t0+n) in (SUM35ind1 (pf, pf3) | t)
    end else let
      val (pf5 | r5) = nmod (n, 5)
    in
      if r5 = 0 then let
        val (pf | t) = loop (n-1, t0+n) in (SUM35ind2 (pf, pf5) | t)
      end else let
        val (pf | t) = loop (n-1, t0) in (SUM35ind3 (pf, pf3, pf5) | t)
      end // end of [if]
    end // end of [if]
  end else
    (SUM35bas () | t0)
  // end of [if]
) (* end of [loop] *)
//
in
  loop (n, 0)
end // end if [sum35]

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

val () = {
//
#define N 1000
//
val (pf | ans) = sum35 (N-1)
val () = assertloc (ans = 233168)
val () =
(
  println! ("The sum of all the natural numbers < ", N, " that are multiples of 3 or 5 = ", ans)
) (* end of [val] *)
} (* end of [main0] *)

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

(* end of [P1-hwxi.dats] *)

(*
** Project Euler: P1
** See https://projecteuler.net
*)

(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTcom
// Start time: January 13, 2015
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
#include
"{$LIBATSCC2JS}/staloadall.hats"
//
(* ****** ****** *)

staload
"{$LIBATSCC2JS}/SATS/print.sats"

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

#define ATS_MAINATSFLAG 1
#define ATS_DYNLOADNAME "my_dynload"

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

%{
function
atspre_g0int_mod_int(n, p) { return (n%p); }
%} // end of [%{]

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

%{$
//
ats2jspre_the_print_store_clear();
my_dynload();
alert(ats2jspre_the_print_store_join());
//
%} // end of [%{$]

(* ****** ****** *)
//
staload
"{$LIBATSHWXI}/PEULER/PROJECT/P1/P1.sats"
//
(* ****** ****** *)

implement
sum35 (n) = let
//
fun loop
  {n:nat}{t0:int} .<n>.
(
  n: int n, t0: int t0
) :<> [t:int | t >= t0] (SUM35 (n, t-t0) | int (t)) =
(
  if n > 0 then let
    val (pf3 | r3) = nmod (n, 3)
  in
    if r3 = 0 then let
      val (pf | t) = loop (n-1, t0+n) in (SUM35ind1 (pf, pf3) | t)
    end else let
      val (pf5 | r5) = nmod (n, 5)
    in
      if r5 = 0 then let
        val (pf | t) = loop (n-1, t0+n) in (SUM35ind2 (pf, pf5) | t)
      end else let
        val (pf | t) = loop (n-1, t0) in (SUM35ind3 (pf, pf3, pf5) | t)
      end // end of [if]
    end // end of [if]
  end else
    (SUM35bas () | t0)
  // end of [if]
) (* end of [loop] *)
//
in
  loop (n, 0)
end // end if [sum35]

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

implement
main0 () =
{
//
#define N 1000
//
val (pf | ans) = sum35 (N-1)
val () = assertloc (ans = 233168)
val () =
(
  println! ("The sum of all the natural numbers < ", N, " that are multiples of 3 or 5 = ", ans)
) (* end of [val] *)
} (* end of [main0] *)

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

(* end of [P1-hwxi.dats] *)


Updating: working on chardev-1

Updating: working on chardev-1

(*
** A simple char device
*)

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

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

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

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

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

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

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

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

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

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

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

typedef charptr = $extype"charptr"

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

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

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

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

%{^

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

static void *fops_ptr = &(fops);

%} // end of [%{^]

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

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

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

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

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

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

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

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

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

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

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

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

implement
device_read_
  (filp, buf, n, ofs) = let
in
  g0i2i(0)
end // end of [device_read_]

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

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

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

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

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

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

(*
** A simple char device
*)

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

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

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

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

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

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

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

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

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

typedef charptr = $extype"charptr"

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

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

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

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

%{^

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

static void *fops_ptr = &(fops);

%} // end of [%{^]

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

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

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

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

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

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

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

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

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

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

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

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

implement
device_read_
  (filp, buf, n, ofs) = let
in
  g0i2i(0)
end // end of [device_read_]

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

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

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

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

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

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


Snatch with ATS

Snatch with ATS

%{^
#include "LPC17xx.h"
#include "wait_api.h"
%}

%{
void c_set_gpio1_fiodir(uint32_t val)
{
	LPC_GPIO1->FIODIR = val;
}

void c_set_gpio1_fiopin(uint32_t val)
{
	LPC_GPIO1->FIOPIN = val;
}
%}

#define BLINK_DELAY_US 500000

extern fun c_set_gpio1_fiodir(v: int): void = "mac#"
extern fun c_set_gpio1_fiopin (v: int): void = "mac#"
extern fun c_wait_us (us: int): void = "mac#wait_us"

fun loop (): void = begin
  c_set_gpio1_fiopin (0x40000); // 1 << 18
  c_wait_us (BLINK_DELAY_US);
  c_set_gpio1_fiopin (0x0);
  c_wait_us (BLINK_DELAY_US);
  loop ();
end

implement main0 () = begin
  c_set_gpio1_fiodir (0xb40000); // 1<<18 | 1<<20 | 1<<21 | 1<<23
  loop ();
end

%{^
#include "LPC17xx.h"
%}

%{
volatile int g_LoopDummy;

void c_blink(void)
{
	LPC_GPIO1->FIODIR |= 1 << 18; // P1.18 connected to LED1
	while(1)
	{
		int i;

		LPC_GPIO1->FIOPIN ^= 1 << 18; // Toggle P1.18
		for (i = 0 ; i < 5000000 && !g_LoopDummy ; i++)
		{
		}
	}
}
%}

extern fun c_blink (): void = "mac#"

implement main0 () = c_blink ()


A bit change

A bit change

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

staload "{$TOP}/SATS/arduino.sats"
staload UN = "prelude/SATS/unsafe.sats"

#define LED 9
#define DELAY_MS 10.0

fun int_foreach_clo
  (n: natLt(256), f: &natLt(256) -<clo1> void): void = {
  val () = f n
  val () = if n > 0 then int_foreach_clo (n - 1, f)
}

implement main () = {
  fun fadein() = let
    var fwork = lam@ (n: natLt(256)) => {
      val () = analogWrite (LED, n)
      val () = delay_ms(DELAY_MS)
    }
  in
    int_foreach_clo(255, fwork)
  end // end of [fadein]
  (* val () = init () *)
  val () = pinMode (LED, OUTPUT)
  val () = (fix f(): void => (fadein(); f()))()
}

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

staload "{$TOP}/SATS/arduino.sats"
staload UN = "prelude/SATS/unsafe.sats"

#define LED 9
#define DELAY_MS 10.0

fun int_foreach_clo
  (n: natLt(256), f: &natLt(256) -<clo1> void): void = {
  val () = f n
  val () = if n > 0 then int_foreach_clo (n - 1, f)
}

implement main () = {
  fun fadein() = let
    var fwork = lam@ (n: natLt(256)) => {
      val () = analogWrite (LED, $UN.cast n)
      val () = delay_ms(DELAY_MS)
    }
  in
    int_foreach_clo(255, fwork)
  end // end of [fadein]
  val () = pinMode (LED, OUTPUT)
  val () = (fix f(): void => (fadein(); f()))()
}


Updating: adding contrib/sdstring

Updating: adding contrib/sdstring

(*
** For Simple Dynamic Strings:
** https://github.com/antirez/sds/
*)

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

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

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

(*
** Author: Hanwen Wu (Summer 2014)
** Author: Hongwei Xi (February 2015)
*)

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

#define
ATS_PACKNAME "ATSCNTRB.sdstring" // package name
#define
ATS_EXTERN_PREFIX "atscntrb_sdstring_" // prefix for external names

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

%{#
//
#include \
"sdstring/CATS/sdstring.cats"
//
%} // end of [%{#}

(* ****** ****** *)
//
absvtype
sds_vtype(l:addr) = ptr(l)
//
vtypedef sds(l:addr) = sds_vtype(l)
//
vtypedef sds0 = [l:addr] sds(l)
vtypedef sds1 = [l:addr | l > null] sds(l)
//
(* ****** ****** *)
//
castfn
sds2ptr
  {l:addr}(!sds(l)):<> ptr(l)
//
overload ptrcast with sds2ptr
//
(* ****** ****** *)
//
fun
sdsnew(RD(string)): sds0 = "mac#%"
//
fun
sdsnewlen{n:int}
  (arrayref(char, n), sizeLte(n)): sds0 = "mac#%"
//
(* ****** ****** *)

fun sdsempty((*void*)): sds0 = "mac#%"

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

fun sdsdup(sds: !sds0): sds0 = "mac#%"

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

fun sdsfree (sds: sds0): void = "mac#%"

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

fun sdscmp (!sds0, !sds0): int = "mac#%"

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

fun sdslen(sds: !sds0): size_t = "mac#%"
fun sdsavail(sds: !sds0): size_t = "mac#%"

(* ****** ****** *)
//
fun
sdsgrowzero(sds: sds0, len: size_t): sds0 = "mac#%"
//
(* ****** ****** *)
//
fun sdscat(sds: sds0, string): sds0 = "mac#%"
fun sdscatsds(sds1: sds0, sds2: !sds0): sds0 = "mac#%"
(*
fun sdscatlen(sds0, string, size_t): sds0 = "mac#%"
fun sdscatrepr(sds0, string, size_t): sds0 = "mac#%"
fun sdscatprintf{ts:t@ype}(sds, fmt: string, ts): sds0 = "mac#%"
*)
//
(* ****** ****** *)
//
fun sdscpy(sds1: sds0, sds2: !sds0): sds0 = "mac#%"
(*
fun sdscpylen(sds0, string, size_t): sds0 = "mac#%"
*)
//
(* ****** ****** *)
//
fun
sdstrim{l:addr}
  (sds: !sds(l) >> _, string): void = "mac#%"
fun
sdsrange{l:addr}
  (sds: !sds(l) >> _, _beg: int, _end: int): void = "mac#%"
//
(* ****** ****** *)

fun sdstolower{l:addr}(sds: !sds(l) >> _): void = "mac#%"
fun sdstoupper{l:addr}(sds: !sds(l) >> _): void = "mac#%"

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

fun sdsfromlonglong(inp: llint): sds0 = "mac#%"

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

fun
sdsjoin{n,n2:int}
(
  arrayref(string, n), int(n), sep: string(n2), size_t(n2)
) : sds0 = "mac#%" // end of [sdsjoin]

fun
sdsjoinsds{n,n2:int}
(
  sdss: !arrayptr(sds0, n), int(n), sep: string(n2), size_t(n2)
) : sds0 = "mac#%" // end of [sdsjoinsds]

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

fun
sdsmapchars{l:addr}{n:int}
(
  sds: !sds(l) >> _, _from: string(n), _to: string(n), size_t(n)
) : void = "mac#%" // end of [sdsmapchars]

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

(* end of [sdstring.sats] *)

(*
** For Simple Dynamic Strings:
** https://github.com/antirez/sds/
*)

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

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

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

#define
ATS_PACKNAME "ATSCNTRB.sdstring" // package name
#define
ATS_EXTERN_PREFIX "atscntrb_sdstring_" // prefix for external names

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

%{#
//
#include \
"sdstring/CATS/sdstring.cats"
//
%} // end of [%{#}

(* ****** ****** *)
//
absvtype
sds_vtype(l:addr) = ptr(l)
//
vtypedef sds(l:addr) = sds_vtype(l)
//
vtypedef sds0 = [l:addr] sds(l)
vtypedef sds1 = [l:addr | l > null] sds(l)
//
(* ****** ****** *)
//
castfn
sds2ptr
  {l:addr}(!sds(l)):<> ptr(l)
//
overload ptrcast with sds2ptr
//
(* ****** ****** *)
//
fun
sdsnew(RD(string)): sds0 = "mac#%"
//
fun
sdsnewlen{n:int}
  (arrayref(char, n), sizeLte(n)): sds0 = "mac#%"
//
(* ****** ****** *)

fun sdsempty((*void*)): sds0 = "mac#%"

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

fun sdsdup(sds: !sds0): sds0 = "mac#%"

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

fun sdsfree (sds: sds0): void = "mac#%"

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

fun sdscmp (!sds0, !sds0): int = "mac#%"

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

fun sdslen(sds: !sds0): size_t = "mac#%"
fun sdsavail(sds: !sds0): size_t = "mac#%"

(* ****** ****** *)
//
fun
sdsgrowzero(sds: sds0, len: size_t): sds0 = "mac#%"
//
(* ****** ****** *)
//
fun sdscat(sds: sds0, string): sds0 = "mac#%"
fun sdscatsds(sds1: sds0, sds2: !sds0): sds0 = "mac#%"
(*
fun sdscatlen(sds0, string, size_t): sds0 = "mac#%"
fun sdscatrepr(sds0, string, size_t): sds0 = "mac#%"
fun sdscatprintf{ts:t@ype}(sds, fmt: string, ts): sds0 = "mac#%"
*)
//
(* ****** ****** *)
//
fun sdscpy(sds1: sds0, sds2: !sds0): sds0 = "mac#%"
(*
fun sdscpylen(sds0, string, size_t): sds0 = "mac#%"
*)
//
(* ****** ****** *)
//
fun
sdstrim{l:addr}
  (sds: !sds(l) >> _, string): void = "mac#%"
fun
sdsrange{l:addr}
  (sds: !sds(l) >> _, _beg: int, _end: int): void = "mac#%"
//
(* ****** ****** *)

fun sdstolower{l:addr}(sds: !sds(l) >> _): void = "mac#%"
fun sdstoupper{l:addr}(sds: !sds(l) >> _): void = "mac#%"

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

fun sdsfromlonglong(inp: llint): sds0 = "mac#%"

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

fun
sdsjoin{n,n2:int}
(
  arrayref(string, n), int(n), sep: string(n2), size_t(n2)
) : sds0 = "mac#%" // end of [sdsjoin]

fun
sdsjoinsds{n,n2:int}
(
  sdss: !arrayptr(sds0, n), int(n), sep: string(n2), size_t(n2)
) : sds0 = "mac#%" // end of [sdsjoinsds]

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

fun
sdsmapchars{l:addr}{n:int}
(
  sds: !sds(l) >> _, _from: string(n), _to: string(n), size_t(n)
) : void = "mac#%" // end of [sdsmapchars]

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

(* end of [sdstring.sats] *)


Add static value into analog API

Add static value into analog API

%{^
#include <avr/io.h>
#include <util/delay.h>
#include "Arduino.h"
%}

abst@ype HIGHLOW = $extype"uint8_t"
macdef   HIGH    = $extval(HIGHLOW, "HIGH")
macdef   LOW     = $extval(HIGHLOW, "LOW")

abst@ype INOUT  = $extype"uint8_t"
macdef   INPUT  = $extval(INOUT, "INPUT")
macdef   OUTPUT = $extval(INOUT, "OUTPUT")

macdef LED_BUILTIN = $extval(uint8, "LED_BUILTIN")
macdef A0          = $extval(uint8, "A0")

abst@ype ANALOG_REFERENCE = $extype"uint8_t"
macdef DEFAULT = $extval(ANALOG_REFERENCE, "DEFAULT")
macdef INTERNAL = $extval(ANALOG_REFERENCE, "INTERNAL")
macdef EXTERNAL = $extval(ANALOG_REFERENCE, "EXTERNAL")

fun pinMode (pin: uint8, mode: INOUT): void = "mac#"
fun digitalWrite (pin: uint8, value: HIGHLOW): void = "mac#"
fun digitalRead (pin: uint8): HIGHLOW = "mac#"
fun analogReference (atype: ANALOG_REFERENCE): void = "mac#"
fun analogRead (pin: uint8): [n:nat | n <= 1023] int n = "mac#"
fun analogWrite {n:nat | n <= 255} (pin: uint8, value: int n): void = "mac#"
fun delay_ms (ms: double): void = "mac#_delay_ms"
fun delay_us (us: double): void = "mac#_delay_us"
fun interrupts (): void = "mac#"
fun nointerrupts (): void = "mac#"

%{^
#include <avr/io.h>
#include <util/delay.h>
#include "Arduino.h"
%}

abst@ype HIGHLOW = $extype"uint8_t"
macdef   HIGH    = $extval(HIGHLOW, "HIGH")
macdef   LOW     = $extval(HIGHLOW, "LOW")

abst@ype INOUT  = $extype"uint8_t"
macdef   INPUT  = $extval(INOUT, "INPUT")
macdef   OUTPUT = $extval(INOUT, "OUTPUT")

macdef LED_BUILTIN = $extval(uint8, "LED_BUILTIN")
macdef A0          = $extval(uint8, "A0")

abst@ype ANALOG_REFERENCE = $extype"uint8_t"
macdef DEFAULT = $extval(ANALOG_REFERENCE, "DEFAULT")
macdef INTERNAL = $extval(ANALOG_REFERENCE, "INTERNAL")
macdef EXTERNAL = $extval(ANALOG_REFERENCE, "EXTERNAL")

fun pinMode (pin: uint8, mode: INOUT): void = "mac#"
fun digitalWrite (pin: uint8, value: HIGHLOW): void = "mac#"
fun digitalRead (pin: uint8): HIGHLOW = "mac#"
fun analogReference (atype: ANALOG_REFERENCE): void = "mac#"
fun analogRead (pin: uint8): int = "mac#"
fun analogWrite (pin: uint8, value: int): void = "mac#"
fun delay_ms (ms: double): void = "mac#_delay_ms"
fun delay_us (us: double): void = "mac#_delay_us"
fun interrupts (): void = "mac#"
fun nointerrupts (): void = "mac#"


Update atscc2js.dats

Update atscc2js.dats

(*
//
// For invoking [patsopt]
//
*)

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
#define ATS_DYNLOADFLAG 0
//
#define
ATS_EXTERN_PREFIX "tutorats_"
#define
ATS_STATIC_PREFIX "_tutorats_patsopt_"
//
(* ****** ****** *)
//
staload
"{$LIBATSCC2PHP}/basics_php.sats"
staload
"{$LIBATSCC2PHP}/SATS/integer.sats"
staload
"{$LIBATSCC2PHP}/SATS/filebas.sats"
//
staload
"{$LIBATSCC2PHP}/SATS/PHParray.sats"
//
(* ****** ****** *)
//
staload "./../SATS/basics.sats"
//
(* ****** ****** *)
//
implement
{}(*tmp*)
atscc2js_get () = "atscc2js"
//
(* ****** ****** *)
//
extern
fun
file_get_contents (fname: string): string = "mac#"
//
(* ****** ****** *)

implement
{}(*tmp*)
atscc2js_format_command
(
  fname_dats_c, fname_dats_js, fname_dats_js_log
) = let
//
val atscc2js = atscc2js_get<> ()
//
in
//
$extfcall
(
  string, "sprintf"
, "%s 2>%s -o %s -i %s"
, atscc2js, fname_dats_js_log, fname_dats_js, fname_dats_c
) (* end of [$extfcall] *)
//
end // end of [atscc2js_format_command]

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

implement
{}(*tmp*)
atscc2js_file
  (flag, fname_dats_c) = atscc2js_res where
{
//
val dir =
  $extfcall(string, "sys_get_temp_dir")
val fname_dats_js =
  $extfcall (string, "tempnam", dir, "atscc2js")
val fname_dats_js_log =
  $extfcall (string, "tempnam", dir, "atscc2js")
//
val
command =
atscc2js_format_command
(
  fname_dats_c, fname_dats_js, fname_dats_js_log
) (* end of [val] *)
//
val
exec_ret = exec_retval (command)
//
val
atscc2js_res =
(
//
if exec_ret = 0
  then let
    val str =
      file_get_contents (fname_dats_js)
    // end of [val]
  in
    COMPRES0_succ (str)
  end // end of [then]
  else (
    if flag = 0
      then let
        val str2 =
          file_get_contents (fname_dats_js_log)
        // end of [val]
      in
        COMPRES1_fail (str2)
      end // end of [then]
      else let
        val str1 =
          file_get_contents (fname_dats_c)
        // end of [val]
        val str2 =
          file_get_contents (fname_dats_js_log)
        // end of [val]
      in
        COMPRES2_fail (str1, str2)
      end // end of [else]
    // end of [if]
  ) (* end of [else] *)
// end of [if]
) : compres // end of [val]
//
val unlink_ret = unlink (fname_dats_js)
val unlink_ret = unlink (fname_dats_js_log)
//
} (* end of [atscc2js_file] *)

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

(* end of [atscc2js.dats] *)

(*
//
// For invoking [patsopt]
//
*)

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
#define ATS_DYNLOADFLAG 0
//
#define
ATS_EXTERN_PREFIX "tutorats_"
#define
ATS_STATIC_PREFIX "_tutorats_patsopt_"
//
(* ****** ****** *)
//
staload
"{$LIBATSCC2PHP}/basics_php.sats"
staload
"{$LIBATSCC2PHP}/SATS/integer.sats"
staload
"{$LIBATSCC2PHP}/SATS/filebas.sats"
//
staload
"{$LIBATSCC2PHP}/SATS/PHParray.sats"
//
(* ****** ****** *)
//
staload "./../SATS/basics.sats"
//
(* ****** ****** *)
//
implement
{}(*tmp*)
atscc2js_get () = "atscc2js"
//
(* ****** ****** *)
//
extern
fun
file_get_contents (fname: string): string = "mac#"
//
(* ****** ****** *)

implement
{}(*tmp*)
atscc2js_format_command
(
  fname_dats_c, fname_dats_js, fname_dats_js_log
) = let
//
val atscc2js = atscc2js_get<> ()
//
in
//
$extfcall
(
  string, "sprintf"
, "%s 2>%s -o %s -i %s"
, atscc2js, fname_dats_js_log, fname_dats_js, fname_dats_c
) (* end of [$extfcall] *)
//
end // end of [atscc2js_format_command]

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

implement
{}(*tmp*)
atscc2js_file
  (flag, fname_dats_c) = atscc2js_res where
{
//
val dir =
  $extfcall(string, "sys_get_temp_dir")
val fname_dats_js =
  $extfcall (string, "tempnam", dir, "atscc2js")
val fname_dats_js_log =
  $extfcall (string, "tempnam", dir, "atscc2js")
//
val
command =
atscc2js_format_command
(
  fname_dats_c, fname_dats_js, fname_dats_js_log
) (* end of [val] *)
//
val
exec_ret = exec_retval (command)
//
val
atscc2js_res =
(
//
if exec_ret = 0
  then let
    val str =
      file_get_contents (fname_dats_js)
    // end of [val]
  in
    COMPRES0 (str)
  end // end of [then]
  else (
    if flag = 0
      then let
        val str2 =
          file_get_contents (fname_dats_js_log)
        // end of [val]
      in
        COMPRES1 (str2)
      end // end of [then]
      else let
        val str1 =
          file_get_contents (fname_dats_c)
        // end of [val]
        val str2 =
          file_get_contents (fname_dats_js_log)
        // end of [val]
      in
        COMPRES2 (str1, str2)
      end // end of [else]
    // end of [if]
  ) (* end of [else] *)
// end of [if]
) : compres // end of [val]
//
val unlink_ret = unlink (fname_dats_js)
val unlink_ret = unlink (fname_dats_js_log)
//
} (* end of [atscc2js_file] *)

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

(* end of [atscc2js.dats] *)


Updating: minorly tidying-up a bit

Updating: minorly tidying-up a bit

(*
** For reasoning
** about real numbers
*)

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

datasort real = (* abstract *)

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

stacst neg_real : (real) -> real

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

stacst
add_real_real : (real, real) -> real
stacst
sub_real_real : (real, real) -> real
stacst
mul_real_real : (real, real) -> real
stacst
div_real_real : (real, real) -> real

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

stadef ~ = neg_real
stadef + = add_real_real
stadef - = sub_real_real
stadef * = mul_real_real
stadef / = div_real_real

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

stacst
real_of_int : (int) -> real
stacst
real_of_float : (float) -> real

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

stadef i2r = real_of_int
stadef f2r = real_of_float

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

stacst
lt_real_real : (real, real) -> bool
stacst
lte_real_real : (real, real) -> bool
stacst
gt_real_real : (real, real) -> bool
stacst
gte_real_real : (real, real) -> bool
stacst
eq_real_real : (real, real) -> bool
stacst
neq_real_real : (real, real) -> bool

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

stadef < = lt_real_real
stadef <= = lte_real_real
stadef > = gt_real_real
stadef >= = gte_real_real
stadef == = eq_real_real
stadef != = neq_real_real

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

(* end of [real.sats] *)