Simple linear object in ATSCC2JS

gistfile1.txt

(*
** Hello, world!
*)

(* ****** ****** *)
//
#define
LIBATSCC2JS_targetloc
"$PATSHOME\
/contrib/libatscc2js/ATS2-0.3.2"
//
#include
"{$LIBATSCC2JS}/staloadall.hats"
//
(* ****** ****** *)

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

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

#define ATS_MAINATSFLAG 1
#define ATS_DYNLOADNAME "my_dynload"

(* ****** ****** *)
//
// Simple Linear Objects in ATS
//
(* ****** ****** *)
//
// Implementing a timer (that is, a stopwatch)
//
(* ****** ****** *)

absvtype timer_vtype
vtypedef timer = timer_vtype

extern
fun timer_new (): timer = "mac#" // creating a timer object
extern
fun timer_free (x: timer): void = "mac#" // destroying a timer object
extern
fun timer_start (x: !timer): void = "mac#" // the timer starts
extern
fun timer_finish (x: !timer): void = "mac#" // the timer finishes
extern
fun timer_pause (x: !timer): void = "mac#" // the timer pauses
extern
fun timer_resume (x: !timer): void = "mac#" // the (paused) timer resumes
extern
fun timer_reset (x: !timer): void = "mac#" // the timer resets
extern
fun timer_get_ntick (x: !timer): uint = "mac#" // obtaining the number of ticks

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

typedef
timer_struct = @{
  started= bool // the timer has started
, running= bool // the timer is running
  // the tick number recorded
, ntick_beg= uint // when the timer was turned on
, ntick_acc= uint // the number of accumulated ticks
} (* end of [timer_struct] *)

(* ****** ****** *)
//
(*
extern
castfn timer_objfize
  {l:addr} (timer_struct@l | ptr l): (mfree_ngc_v (l) | timer)
extern
castfn timer_unobjfize
  {l:addr} (mfree_ngc_v (l) | timer): (timer_struct @ l | ptr l)
*)
//
(* ****** ****** *)
//
datavtype timer =
  | TIMER of (timer_struct)
//
(* ****** ****** *)

assume timer_vtype = timer

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

implement
timer_new () = let
//
val timer = TIMER (_)
val+TIMER (x) = timer
//
val () = x.started := false
val () = x.running := false
val () = x.ntick_beg := 0u
val () = x.ntick_acc := 0u
//
prval () = fold@ (timer)
//
in
  timer
end // end of [timer_new]

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

implement
timer_free (timer) =
  let val+~TIMER _ = timer in (*nothing*) end
// end of [timer_free]

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

extern
fun the_current_tick_get (): uint = "mac#"

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

implement
timer_start
  (timer) = let
  val+@TIMER(x) = timer
  val () = x.started := true
  val () = x.running := true
  val () = x.ntick_beg := the_current_tick_get ()
  val () = x.ntick_acc := 0u
  prval () = fold@ (timer)
in
  // nothing
end // end of [timer_start]

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

implement
timer_finish
  (timer) = let
  val+@TIMER(x) = timer
  val () = x.started := false
  val () =
  if x.running then
  {
    val () = x.running := false
    val () = x.ntick_acc :=
      x.ntick_acc + the_current_tick_get () - x.ntick_beg
  } (* end of [val] *)
  prval () = fold@ (timer)
in
  // nothing
end // end of [timer_finish]

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

implement
timer_pause
  (timer) = let
  val+@TIMER(x) = timer
  val () =
  if x.running then
  {
    val () = x.running := false
    val () = x.ntick_acc :=
      x.ntick_acc + the_current_tick_get () - x.ntick_beg
  } (* end of [val] *)
  prval () = fold@ (timer)
in
  // nothing
end // end of [timer_pause]

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

implement
timer_resume
  (timer) = let
  val+@TIMER(x) = timer
  val () =
  if x.started && ~(x.running) then
  {
    val () = x.running := true
    val () = x.ntick_beg := the_current_tick_get ()
  } (* end of [if] *) // end of [val]
  prval () = fold@ (timer)
in
  // nothing
end // end of [timer_resume]

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

implement
timer_reset
  (timer) = let
  val+@TIMER(x) = timer
  val () = x.started := false
  val () = x.running := false
  val () = x.ntick_beg := 0u
  val () = x.ntick_acc := 0u
  prval () = fold@ (timer)
in
  // nothing
end // end of [timer_reset]

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

implement
timer_get_ntick
  (timer) = let
  val+@TIMER(x) = timer
  var ntick: uint = x.ntick_acc
  val () =
  if x.running then (
    ntick := ntick + the_current_tick_get () - x.ntick_beg
  ) (* end of [if] *) // end of [val]
  prval () = fold@ (timer)
in
  ntick
end // end of [timer_get_ntick]

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

//
implement
the_current_tick_get () = 0u

(* ****** ****** *)
//
extern
fun
hello(): void = "mac#"
implement
hello() = {
//
val timer = timer_new ()
//
val () = timer_start (timer)
//
val ntick = timer_get_ntick (timer)
val ((*void*)) = println! ("ntick(0) = ", ntick)
//val _(*nleft*) = $UNIX.sleep (1u) // this one is counted
val ((*void*)) = timer_pause (timer)
val ntick = timer_get_ntick (timer)
val ((*void*)) = println! ("ntick(1) = ", ntick)
//val _(*nleft*) = $UNIX.sleep (1u) // this one is skipped
val ((*void*)) = timer_resume (timer)
//val _(*nleft*) = $UNIX.sleep (1u) // this one is counted
val ntick = timer_get_ntick (timer)
val ((*void*)) = println! ("ntick(2) = ", ntick)
//
val () = timer_finish (timer)
//
val ((*freed*)) = timer_free (timer)
//
}
//
(* ****** ****** *)
//
val () = hello()
//
(* ****** ****** *)

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

Code is by Hongwei Xi.