Updating: very minorly tidying-up

Updating: very minorly tidying-up

(***********************************************************************)
(*                                                                     *)
(*                         ATS/contrib/atshwxi                         *)
(*                                                                     *)
(***********************************************************************)

(*
** Copyright (C) 2014 Hongwei Xi, ATS Trustful Software, Inc.
**
** Permission is hereby granted, free of charge, to any person obtaining a
** copy of this software and associated documentation files (the "Software"),
** to deal in the Software without restriction, including without limitation
** the rights to use, copy, modify, merge, publish, distribute, sublicense,
** and/or sell copies of the Software, and to permit persons to whom the
** Software is furnished to do so, subject to the following stated conditions:
**
** The above copyright notice and this permission notice shall be included in
** all copies or substantial portions of the Software.
**
** THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
** OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
** FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
** THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
** LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
** FROM OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
** IN THE SOFTWARE.
*)

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

(*
absvt@ype T
#define CAPACITY1 (= CAPACITY + 1)
*)

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

extern fun get_size ():<> size_t
extern fun get_capacity ():<> size_t

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

extern fun is_nil ():<> bool
extern fun isnot_nil ():<> bool
extern fun is_full ():<> bool
extern fun isnot_full ():<> bool

(* ****** ****** *)
//
exception
GDEQARRAYinsert of ()
//
extern
fun
insert_atbeg
(
  x0: T, res: &T? >> opt (T, b)
) : #[b:bool] bool(b) // endfun
//
extern
fun insert_atbeg_exn (x0: T): void
extern
fun insert_atbeg_opt (x0: T): Option_vt (T)
//
extern
fun
insert_atend
(
  x0: T, res: &T? >> opt (T, b)
) : #[b:bool] bool(b) // endfun
//
extern
fun insert_atend_exn (x0: T): void
extern
fun insert_atend_opt (x0: T): Option_vt (T)
//
(* ****** ****** *)
//
exception
GDEQARRAYtakeout of ()
//
extern
fun
takeout_atbeg
(
  x0: &T? >> opt (T, b)
) : #[b:bool] bool (b) // endfun
//
extern
fun takeout_atbeg_exn ((*void*)): T
extern
fun takeout_atbeg_opt ((*void*)): Option_vt (T)
//
extern
fun
takeout_atend
(
  x0: &T? >> opt (T, b)
) : #[b:bool] bool (b) // endfun
//
extern
fun takeout_atend_exn ((*void*)): T
extern
fun takeout_atend_opt ((*void*)): Option_vt (T)
//
(* ****** ****** *)

local
//
staload "libats/SATS/deqarray.sats"
staload _ = "libats/DATS/deqarray.dats"
//
staload UN = "prelude/SATS/unsafe.sats"
//
#define
CAPACITY (CAPACITY1-1)
//
local
var _array = @[T][CAPACITY1]()
in (*in-of-local*)
val the_arrayptr =
$UN.castvwtp0{arrayptr(T?,CAPACITY1)}((view@_array | addr@_array))
end // end of [local]
//
local
val cap = CAPACITY
var _struct: deqarray_tsize // uninitized
in (*in-of-local*)
val (pfngc | the_deqarray) =
deqarray_make_ngc__tsz{T}(view@_struct | addr@_struct, the_arrayptr, i2sz(cap), sizeof<T>)
end // end of [local]
//
vtypedef DQA = [n:nat] deqarray(T, CAPACITY, n)
val the_deqarray_ptr = $UN.castvwtp0{ptr}((pfngc | the_deqarray))
//
in (* in-of-local *)

implement
get_size () = res where
{
//
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_get_size (dqa)
prval ((*void*)) = $UN.cast2void (dqa)
//
} (* end of [get_size] *)

implement
get_capacity () = res where
{
//
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_get_capacity (dqa)
prval ((*void*)) = $UN.cast2void (dqa)
//
} (* end of [get_capacity] *)

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

implement
is_nil () = res where
{
//
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_is_nil (dqa)
prval ((*void*)) = $UN.cast2void (dqa)
//
} (* end of [is_nil] *)

implement
isnot_nil () = res where
{
//
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_isnot_nil (dqa)
prval ((*void*)) = $UN.cast2void (dqa)
//
} (* end of [isnot_nil] *)

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

implement
is_full () = res where
{
//
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_is_full (dqa)
prval ((*void*)) = $UN.cast2void (dqa)
//
} (* end of [is_full] *)

implement
isnot_full () = res where
{
//
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_isnot_full (dqa)
prval ((*void*)) = $UN.cast2void (dqa)
//
} (* end of [isnot_full] *)

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

implement
insert_atbeg
  (x0, res) = let
//
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
val isnot = deqarray_isnot_full (dqa)
//
in
//
if isnot
  then let
    val () = deqarray_insert_atbeg (dqa, x0)
    prval ((*void*)) = opt_none (res)
    prval ((*void*)) = $UN.cast2void (dqa)
  in
    false
  end // end of [then]
  else let
    val () = res := x0
    prval ((*void*)) = opt_some (res)
    prval ((*void*)) = $UN.cast2void (dqa)
  in
    true
  end // end of [else]
// end of [if]
//
end // end of [insert_atbeg]

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

implement
insert_atbeg_exn(x0) = () where
{
//
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
//
val ((*void*)) = (
//
if
deqarray_isnot_full (dqa)
then deqarray_insert_atbeg (dqa, x0)
else $raise GDEQARRAYinsert((*void*))
//
) : void // end of [val]
//
prval ((*void*)) = $UN.cast2void (dqa)
//
} (* end of [insert_atbeg_exn] *)

implement
insert_atbeg_opt(x0) = res where
{
//
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_insert_atbeg_opt (dqa, x0)
prval ((*void*)) = $UN.cast2void (dqa)
//
} (* end of [insert_atbeg_opt] *)

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

implement
insert_atend
  (x0, res) = let
//
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
val isnot = deqarray_isnot_full (dqa)
//
in
//
if isnot
  then let
    val () = deqarray_insert_atend (dqa, x0)
    prval ((*void*)) = opt_none (res)
    prval ((*void*)) = $UN.cast2void (dqa)
  in
    false
  end // end of [then]
  else let
    val () = res := x0
    prval ((*void*)) = opt_some (res)
    prval ((*void*)) = $UN.cast2void (dqa)
  in
    true
  end // end of [else]
// end of [if]
//
end // end of [insert_atend]

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

implement
insert_atend_exn(x0) = () where
{
//
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
//
val ((*void*)) = (
//
if
deqarray_isnot_full (dqa)
then deqarray_insert_atend (dqa, x0)
else $raise GDEQARRAYinsert((*void*))
//
) : void // end of [val]
//
prval ((*void*)) = $UN.cast2void (dqa)
//
} (* end of [insert_atend_exn] *)

implement
insert_atend_opt(x0) = res where
{
//
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_insert_atend_opt (dqa, x0)
prval ((*void*)) = $UN.cast2void (dqa)
//
} (* end of [insert_atend_opt] *)

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

implement
takeout_atbeg(x0) = let
//
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
val isnot = deqarray_isnot_nil (dqa)
//
in
//
if isnot
  then let
    val () =
    x0 := deqarray_takeout_atbeg (dqa)
    prval () = opt_some{T}(x0)
    prval ((*void*)) = $UN.cast2void (dqa)
  in
    true
  end // end of [then]
  else let
    prval () = opt_none{T}(x0)
    prval ((*void*)) = $UN.cast2void (dqa)
  in
    false
  end // end of [else]
// end of [if]
//
end // end of [takeout_atbeg]

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

implement
takeout_atbeg_exn() = res where
{
//
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
//
val res = (
//
if
deqarray_isnot_nil(dqa)
then deqarray_takeout_atbeg (dqa)
else $raise GDEQARRAYtakeout((*void*))
//
) : T // end of [val]
//
prval ((*void*)) = $UN.cast2void (dqa)
//
} (* end of [takeout_atbeg_exn] *)

implement
takeout_atbeg_opt() = res where
{
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_takeout_atbeg_opt (dqa)
prval ((*void*)) = $UN.cast2void (dqa)
} (* end of [takeout_atbeg_opt] *)

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

implement
takeout_atend(x0) = let
//
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
val isnot = deqarray_isnot_nil (dqa)
//
in
//
if isnot
  then let
    val () =
    x0 := deqarray_takeout_atend (dqa)
    prval ((*void*)) = opt_some{T}(x0)
    prval ((*void*)) = $UN.cast2void (dqa)
  in
    true
  end // end of [then]
  else let
    prval ((*void*)) = opt_none{T}(x0)
    prval ((*void*)) = $UN.cast2void (dqa)
  in
    false
  end // end of [else]
// end of [if]
//
end // end of [takeout_atend]

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

implement
takeout_atend_exn() = res where
{
//
val dqa =
$UN.castvwtp0{DQA}(the_deqarray_ptr)
//
val res = (
//
if
deqarray_isnot_nil(dqa)
then deqarray_takeout_atend (dqa)
else $raise GDEQARRAYtakeout((*void*))
//
) : T // end of [val]
//
prval ((*void*)) = $UN.cast2void (dqa)
//
} (* end of [takeout_atend_exn] *)

implement
takeout_atend_opt() = res where
{
//
val dqa =
  $UN.castvwtp0{DQA}(the_deqarray_ptr)
//
val res = deqarray_takeout_atend_opt (dqa)
prval ((*void*)) = $UN.cast2void (dqa)
//
} (* end of [takeout_atend_opt] *)

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

end // end of [local]

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

(* end of [gdeqarray.hats] *)

(***********************************************************************)
(*                                                                     *)
(*                         ATS/contrib/atshwxi                         *)
(*                                                                     *)
(***********************************************************************)

(*
** Copyright (C) 2014 Hongwei Xi, ATS Trustful Software, Inc.
**
** Permission is hereby granted, free of charge, to any person obtaining a
** copy of this software and associated documentation files (the "Software"),
** to deal in the Software without restriction, including without limitation
** the rights to use, copy, modify, merge, publish, distribute, sublicense,
** and/or sell copies of the Software, and to permit persons to whom the
** Software is furnished to do so, subject to the following stated conditions:
**
** The above copyright notice and this permission notice shall be included in
** all copies or substantial portions of the Software.
**
** THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
** OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
** FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
** THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
** LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
** FROM OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
** IN THE SOFTWARE.
*)

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

(*
absvt@ype T
#define CAPACITY1 (= CAPACITY + 1)
*)

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

extern fun get_size ():<> size_t
extern fun get_capacity ():<> size_t

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

extern fun is_nil ():<> bool
extern fun isnot_nil ():<> bool
extern fun is_full ():<> bool
extern fun isnot_full ():<> bool

(* ****** ****** *)
//
exception
GDEQARRAYinsert of ()
//
extern
fun insert_atbeg
  (x0: T, res: &T? >> opt (T, b)): #[b:bool] bool(b)
extern
fun insert_atbeg_exn (x0: T): void
extern
fun insert_atbeg_opt (x0: T): Option_vt (T)
//
extern
fun insert_atend
  (x0: T, res: &T? >> opt (T, b)): #[b:bool] bool(b)
extern
fun insert_atend_exn (x0: T): void
extern
fun insert_atend_opt (x0: T): Option_vt (T)
//
(* ****** ****** *)
//
exception
GDEQARRAYtakeout of ()
//
extern
fun takeout_atbeg
  (x0: &T? >> opt (T, b)): #[b:bool] bool (b)
extern
fun takeout_atbeg_exn ((*void*)): T
extern
fun takeout_atbeg_opt ((*void*)): Option_vt (T)
//
extern
fun takeout_atend
  (x0: &T? >> opt (T, b)): #[b:bool] bool (b)
extern
fun takeout_atend_exn ((*void*)): T
extern
fun takeout_atend_opt ((*void*)): Option_vt (T)
//
(* ****** ****** *)

local
//
staload
UNSAFE = "prelude/SATS/unsafe.sats"
//
staload "libats/SATS/deqarray.sats"
//
staload _ = "libats/DATS/deqarray.dats"
//
#define
CAPACITY (CAPACITY1-1)
//
local
var _array = @[T][CAPACITY1]()
in (*in-of-local*)
val the_arrayptr =
$UNSAFE.castvwtp0{arrayptr(T?,CAPACITY1)}((view@_array | addr@_array))
end // end of [local]
//
local
val cap = CAPACITY
var _struct: deqarray_tsize // uninitized
in (*in-of-local*)
val (pfngc | the_deqarray) =
deqarray_make_ngc__tsz{T}(view@_struct | addr@_struct, the_arrayptr, i2sz(cap), sizeof<T>)
end // end of [local]
//
vtypedef DQA = [n:nat] deqarray(T, CAPACITY, n)
val the_deqarray_ptr = $UNSAFE.castvwtp0{ptr}((pfngc | the_deqarray))
//
in (* in-of-local *)

implement
get_size () = res where
{
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_get_size (dqa)
prval ((*void*)) = $UNSAFE.cast2void (dqa)
} (* end of [get_size] *)

implement
get_capacity () = res where
{
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_get_capacity (dqa)
prval ((*void*)) = $UNSAFE.cast2void (dqa)
} (* end of [get_capacity] *)

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

implement
is_nil () = res where
{
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_is_nil (dqa)
prval ((*void*)) = $UNSAFE.cast2void (dqa)
} (* end of [is_nil] *)

implement
isnot_nil () = res where
{
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_isnot_nil (dqa)
prval ((*void*)) = $UNSAFE.cast2void (dqa)
} (* end of [isnot_nil] *)

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

implement
is_full () = res where
{
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_is_full (dqa)
prval ((*void*)) = $UNSAFE.cast2void (dqa)
} (* end of [is_full] *)

implement
isnot_full () = res where
{
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_isnot_full (dqa)
prval ((*void*)) = $UNSAFE.cast2void (dqa)
} (* end of [isnot_full] *)

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

implement
insert_atbeg
  (x0, res) = let
//
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
val isnot = deqarray_isnot_full (dqa)
//
in
//
if isnot
  then let
    val () = deqarray_insert_atbeg (dqa, x0)
    prval ((*void*)) = opt_none (res)
    prval ((*void*)) = $UNSAFE.cast2void (dqa)
  in
    false
  end // end of [then]
  else let
    val () = res := x0
    prval ((*void*)) = opt_some (res)
    prval ((*void*)) = $UNSAFE.cast2void (dqa)
  in
    true
  end // end of [else]
// end of [if]
//
end // end of [insert_atbeg]

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

implement
insert_atbeg_exn (x0) = () where
{
//
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
//
val ((*void*)) =
(
if deqarray_isnot_full (dqa)
  then deqarray_insert_atbeg (dqa, x0)
  else $raise GDEQARRAYinsert((*void*))
) : void // end of [val]
//
prval ((*void*)) = $UNSAFE.cast2void (dqa)
//
} (* end of [insert_atbeg_exn] *)

implement
insert_atbeg_opt (x0) = res where
{
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_insert_atbeg_opt (dqa, x0)
prval ((*void*)) = $UNSAFE.cast2void (dqa)
} (* end of [insert_atbeg_opt] *)

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

implement
insert_atend
  (x0, res) = let
//
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
val isnot = deqarray_isnot_full (dqa)
//
in
//
if isnot
  then let
    val () = deqarray_insert_atend (dqa, x0)
    prval ((*void*)) = opt_none (res)
    prval ((*void*)) = $UNSAFE.cast2void (dqa)
  in
    false
  end // end of [then]
  else let
    val () = res := x0
    prval ((*void*)) = opt_some (res)
    prval ((*void*)) = $UNSAFE.cast2void (dqa)
  in
    true
  end // end of [else]
// end of [if]
//
end // end of [insert_atend]

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

implement
insert_atend_exn (x0) = () where
{
//
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
//
val ((*void*)) =
(
if deqarray_isnot_full (dqa)
  then deqarray_insert_atend (dqa, x0)
  else $raise GDEQARRAYinsert((*void*))
) : void // end of [val]
//
prval ((*void*)) = $UNSAFE.cast2void (dqa)
//
} (* end of [insert_atend_exn] *)

implement
insert_atend_opt (x0) = res where
{
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_insert_atend_opt (dqa, x0)
prval ((*void*)) = $UNSAFE.cast2void (dqa)
} (* end of [insert_atend_opt] *)

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

implement
takeout_atbeg (x0) = let
//
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
val isnot = deqarray_isnot_nil (dqa)
//
in
//
if isnot
  then let
    val () =
    x0 := deqarray_takeout_atbeg (dqa)
    prval () = opt_some{T}(x0)
    prval ((*void*)) = $UNSAFE.cast2void (dqa)
  in
    true
  end // end of [then]
  else let
    prval () = opt_none{T}(x0)
    prval ((*void*)) = $UNSAFE.cast2void (dqa)
  in
    false
  end // end of [else]
// end of [if]
//
end // end of [takeout_atbeg]

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

implement
takeout_atbeg_exn () = res where
{
//
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
//
val res =
(
if deqarray_isnot_nil (dqa)
  then deqarray_takeout_atbeg (dqa)
  else $raise GDEQARRAYtakeout((*void*))
) : T // end of [val]
//
prval ((*void*)) = $UNSAFE.cast2void (dqa)
//
} (* end of [takeout_atbeg_exn] *)

implement
takeout_atbeg_opt () = res where
{
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_takeout_atbeg_opt (dqa)
prval ((*void*)) = $UNSAFE.cast2void (dqa)
} (* end of [takeout_atbeg_opt] *)

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

implement
takeout_atend (x0) = let
//
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
val isnot = deqarray_isnot_nil (dqa)
//
in
//
if isnot
  then let
    val () =
    x0 := deqarray_takeout_atend (dqa)
    prval () = opt_some{T}(x0)
    prval ((*void*)) = $UNSAFE.cast2void (dqa)
  in
    true
  end // end of [then]
  else let
    prval () = opt_none{T}(x0)
    prval ((*void*)) = $UNSAFE.cast2void (dqa)
  in
    false
  end // end of [else]
// end of [if]
//
end // end of [takeout_atend]

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

implement
takeout_atend_exn () = res where
{
//
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
//
val res =
(
if deqarray_isnot_nil (dqa)
  then deqarray_takeout_atend (dqa)
  else $raise GDEQARRAYtakeout((*void*))
) : T // end of [val]
//
prval ((*void*)) = $UNSAFE.cast2void (dqa)
//
} (* end of [takeout_atend_exn] *)

implement
takeout_atend_opt () = res where
{
val dqa =
$UNSAFE.castvwtp0{DQA}(the_deqarray_ptr)
val res = deqarray_takeout_atend_opt (dqa)
prval ((*void*)) = $UNSAFE.cast2void (dqa)
} (* end of [takeout_atend_opt] *)

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

end // end of [local]

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

(* end of [gdeqarray.hats] *)


Updating: fixing BUGS/bug-2014-11-14-2

Updating: fixing BUGS/bug-2014-11-14-2

(*
#
# QueenPuzzle
#
*)
(* ****** ****** *)

#define ATS_DYNLOADFLAG 0

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

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

(* ****** ****** *)
//
%{^
typedef char *charptr;
%} // end of [%{^]
//
abstype charptr = $extype"charptr"
//
(* ****** ****** *)
//
%{^
#define N 8
int theArray[N] =
{
  0,0,0,0,0,0,0,0
} ;
%} // end of [%{^]
#define N 8
macdef theArray =
  $extval(arrayref(int,N),"theArray")
//
(* ****** ****** *)
//
fnx
find_next
  {n:pos}
(
  A: arrayref(int, n), n: int(n)
) : bool = let
//
fun
loop
(
  i: natLte(n)
) : natLte(n) =
(
if
i < n
then
  if A[i] > 0 then loop (i+1) else i
else n
) (* end of [loop] *)
//
val i0 = loop (0)
//
in
//
if
i0 < n
then
(
  A[i0] := 1; find2_next (A, n, i0)
) (* end of [then] *)
else
(
  A[n-1] := A[n-1] + 1; find2_next (A, n, n-1)
) (* end of [else] *)
//
end // end of [find_next]

and
find2_next
  {n:pos}
(
  A: arrayref(int, n), n: int(n), i: natLt(n)
) : bool = let
//
fun
test (j: intGte(0)) : bool =
(
if
j >= i
then true
else
(
if
A[i] = A[j]
then false
else (if (i-j=abs(A[i]-A[j])) then false else test(j+1))
) (* end of [else] *)
) (* end of [test] *)
//
in
//
if
A[i] <= n
then let
in
//
if
test(0)
then
(
  if i+1=n then true else find_next(A, n)
) (* end of [then] *)
else (A[i] := A[i]+1; find2_next(A, n, i))
//
end // end of [then]
else let
  val () = A[i] := 0
in
  if i > 0 then (A[i-1] := A[i-1]+1; find2_next (A, n, i-1)) else false
end // end of [else]
//
end // end of [find2_next]

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

macdef LEDPIN = 13
macdef BAUD_RATE = 9600

(* ****** ****** *)
//
extern
fun
setup (): void = "mac#"
//
implement
setup () = () where
{
//
val () = pinMode(LEDPIN, OUTPUT)
val () = Serial_ptr._begin(BAUD_RATE)
//
} (* end of [setup] *)
//
(* ****** ****** *)
//
implement
fprint_val<int>
  (out, x) = let
//
fun
ndot(n: int): void =
if n > 0 then
(
  Serial_ptr.print(". "); ndot(n-1)
) (* end of [if] *)
//
val () = ndot(x-1)
val () = Serial_ptr.print("Q ")
val () = ndot(N-x)
val () = Serial_ptr.println((*void*))
//
in
  // nothing
end // end of [fprint_val]

(* ****** ****** *)
//
implement
fprint_string (out, x) = Serial_ptr.print(x)
//
(* ****** ****** *)
//
implement
fprint_array$sep<> (out) = ()
//
(* ****** ****** *)
//
extern
fun loop (): void = "mac#"
//
implement
loop () =
myloop() where
{
fun
myloop(): void = let
//
val
out = $extval (FILEref, "0")
//
(*
val () =
randomSeed($UN.cast{uint}(millis()))
*)
//
val A = theArray
val found = find_next (A, N)
//
val () =
if found then
{
  val () =
  fprint_arrayref (out, A, i2sz(N))
  val () = Serial_ptr.println()
} (* end of [then] *)
//
val () =
if ~found then
{
//
  val () =
  fprint_string (out, "All solutions are found!")
  val () = Serial_ptr.println()
//
} (* end of [then] *)
//
val () = digitalWrite(LEDPIN, 1)
val () = delay(250)
val () = digitalWrite(LEDPIN, 0)
val () = delay(1000)
//
in
  myloop ()
end // end of [myloop]
//
} (* end of [loop] *)
//
(* ****** ****** *)

(* end of [QueenPuzzle.dats] *)

(*
#
# QueenPuzzle
#
*)
(* ****** ****** *)

#define ATS_DYNLOADFLAG 0

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

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

(* ****** ****** *)
//
%{^
typedef char *charptr;
%} // end of [%{^]
//
abstype charptr = $extype"charptr"
//
(* ****** ****** *)
//
%{^
#define N 8
int theArray[N] =
{
  0,0,0,0,0,0,0,0
} ;
%} // end of [%{^]
#define N 8
macdef theArray =
  $extval(arrayref(int,N),"theArray")
//
(* ****** ****** *)
//
fnx
find_next
  {n:pos}
(
  A: arrayref(int, n), n: int(n)
) : bool = let
//
fun
loop
(
  i: natLte(n)
) : natLte(n) =
(
if
i < n
then
  if A[i] > 0 then loop (i+1) else i
else n
) (* end of [loop] *)
//
val i0 = loop (0)
//
in
//
if
i0 < n
then
(
  A[i0] := 1; find2_next (A, n, i0)
) (* end of [then] *)
else
(
  A[n-1] := A[n-1] + 1; find2_next (A, n, n-1)
) (* end of [else] *)
//
end // end of [find_next]

and
find2_next
  {n:pos}
(
  A: arrayref(int, n), n: int(n), i: natLt(n)
) : bool = let
//
fun
test
(
  A: arrayref(int, n), i: natLt(n), j: intGte(0)
) : bool =
(
if
j >= i
then true
else
(
if
A[i] = A[j]
then false
else (if (i-j=abs(A[i]-A[j])) then false else test(A, i, j+1))
) (* end of [else] *)
) (* end of [test] *)
//
in
//
if
A[i] <= n
then let
in
//
if
test(A, i, 0)
then
(
  if i+1=n then true else find_next(A, n)
) (* end of [then] *)
else (A[i] := A[i]+1; find2_next(A, n, i))
//
end // end of [then]
else let
  val () = A[i] := 0
in
  if i > 0 then (A[i-1] := A[i-1]+1; find2_next (A, n, i-1)) else false
end // end of [else]
//
end // end of [find2_next]

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

macdef LEDPIN = 13
macdef BAUD_RATE = 9600

(* ****** ****** *)
//
extern
fun
setup (): void = "mac#"
//
implement
setup () = () where
{
//
val () = pinMode(LEDPIN, OUTPUT)
val () = Serial_ptr._begin(BAUD_RATE)
//
} (* end of [setup] *)
//
(* ****** ****** *)
//
implement
fprint_val<int>
  (out, x) = let
//
fun
ndot(n: int): void =
if n > 0 then
(
  Serial_ptr.print(". "); ndot(n-1)
) (* end of [if] *)
//
val () = ndot(x-1)
val () = Serial_ptr.print("Q ")
val () = ndot(N-x)
val () = Serial_ptr.println((*void*))
//
in
  // nothing
end // end of [fprint_val]

(* ****** ****** *)
//
implement
fprint_string (out, x) = Serial_ptr.print(x)
//
(* ****** ****** *)
//
implement
fprint_array$sep<> (out) = ()
//
(* ****** ****** *)
//
extern
fun loop (): void = "mac#"
//
implement
loop () =
myloop() where
{
fun
myloop(): void = let
//
val
out = $extval (FILEref, "0")
//
(*
val () =
randomSeed($UN.cast{uint}(millis()))
*)
//
val A = theArray
val found = find_next (A, N)
//
val () =
if found then
{
  val () =
  fprint_arrayref (out, A, i2sz(N))
  val () = Serial_ptr.println()
} (* end of [then] *)
//
val () =
if ~found then
{
//
  val () =
  fprint_string (out, "All solutions are found!")
  val () = Serial_ptr.println()
//
} (* end of [then] *)
//
val () = digitalWrite(LEDPIN, 1)
val () = delay(250)
val () = digitalWrite(LEDPIN, 0)
val () = delay(1000)
//
in
  myloop ()
end // end of [myloop]
//
} (* end of [loop] *)
//
(* ****** ****** *)

(* end of [QueenPuzzle.dats] *)


Updating: more work on mygame.

Updating: more work on mygame.

(*
** SpaceInvaders
*)

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

#define ATS_MAINATSFLAG 1
#define ATS_DYNLOADNAME "my_dynload"

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
(* ****** ****** *)
//
#include
"{$LIBATSCC2JS}/staloadall.hats"
//
(* ****** ****** *)
//
staload
"{$LIBATSCC2JS}/SATS/Bacon.js/baconjs.sats"
//
(* ****** ****** *)

abstype JSevent

(* ****** ****** *)
//
%{^
function
JSevent_keyCode(x){ return x.keyCode; }
%} // end of ...
//
extern
fun
JSevent_keyCode(x: JSevent): int = "mac#"
//
(* ****** ****** *)
//
%{^
//
var
theKeyDowns =
  $(document).asEventStream("keydown")
//
var
theKeyDowns =
theKeyDowns.doAction(".preventDefault")
//
%} // end of ...
//
(* ****** ****** *)

#define KUP 38
#define KDOWN 40
#define KLEFT 37
#define KRIGHT 39

(* ****** ****** *)
//
extern
fun
theKeyDowns_handle
  (fwork: int -<cloref1> void): void
//
(* ****** ****** *)

local
//
val
theKeyDowns =
  $extval(EStream(JSevent), "theKeyDowns")
//
val
theKeyCodes =
  theKeyDowns.map(lam(x) =<cloref1> JSevent_keyCode(x))
//
in (* in-of-local *)

implement
theKeyDowns_handle(fwork) = theKeyCodes.onValue(fwork)

end // end of [local]

(* ****** ****** *)
//
%{^
//
var
theStage = 0;
//
function
theGame_tick(event)
{
  theStage.update(); return;
}
//
function
theGame_initize()
{
  theStage = new createjs.Stage("theGameCanvas");
  createjs.Ticker.addEventListener("tick", theGame_tick);
}
//
%}
//
extern
fun
theGame_initize(): void = "mac#"
//
val () = theGame_initize((*void*))
//
(* ****** ****** *)
//
%{^
//
function
theStage_addChild(x)
{
  theStage.addChild(x); return;
}
//
%} // end of [%{^]
//
extern
fun
theStage_addChild{a:type}(x: a): void = "mac#"
//
(* ****** ****** *)

abstype player
abstype myplayer

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

%{^
//
function
myplayer_new()
{
  var
  player = new createjs.Shape();
  player.x = 0;
  player.y = 0;
  player.graphics.beginFill("yellow").drawCircle(0, 0, 16);
  return { player: player, isadded: 0 };
}
//
function
myplayer_get_player(x0) { return x0.player; }
//
%} // end of [%{]
//
extern
fun
myplayer_new (): myplayer = "mac#"
//
extern
fun
myplayer_get_player (myplayer): player = "mac#"
//
(* ****** ****** *)
//
%{^
//
function
myplayer_incby_x
  (myplayer, dx)
  { myplayer.player.x += dx; return; }
function
myplayer_incby_y
  (myplayer, dy)
  { myplayer.player.y += dy; return; }
//
%} // end of [%{]
//
extern
fun
myplayer_incby_x (myplayer, dx: int): void = "mac#"
extern
fun
myplayer_incby_y (myplayer, dy: int): void = "mac#"
//
(* ****** ****** *)

extern
fun theMyPlayer_get (): Option(myplayer)

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

local

val
theMyPlayer = ref(None)

fun
theMyPlayer_initize(): void =
{
  val x0 = myplayer_new()
  val () = myplayer_incby_x(x0, 16)
  val () = myplayer_incby_y(x0, 640-16)
  val () = theStage_addChild(myplayer_get_player(x0))
  val () = theMyPlayer[] := Some(x0)
}

implement
theMyPlayer_get() = theMyPlayer[]

in (* in-of-local *)

val () = theMyPlayer_initize((*void*))

end // end of [local]

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

local

fun
aux_up(): void = let
//
val opt = theMyPlayer_get()
//
in
//
case+ opt of
| None () => ()
| Some (x0) => myplayer_incby_y(x0, ~10)
//
end // end of [aux_up]
//
fun
aux_down(): void = let
//
val opt = theMyPlayer_get()
//
in
//
case+ opt of
| None () => ()
| Some (x0) => myplayer_incby_y(x0, (10))
//
end // end of [aux_down]
//
fun
aux_left(): void = let
//
val opt = theMyPlayer_get()
//
in
//
case+ opt of
| None () => ()
| Some (x0) => myplayer_incby_x(x0, ~10)
//
end // end of [aux_left]
//
fun
aux_right(): void = let
//
val opt = theMyPlayer_get()
//
in
//
case+ opt of
| None () => ()
| Some (x0) => myplayer_incby_x(x0, (10))
//
end // end of [aux_right]

fun
fwork_keycode(c: int) =
(
case+ 0 of
//
| _ when c = KUP => aux_up()
| _ when c = KDOWN => aux_down()
| _ when c = KLEFT => aux_left()
| _ when c = KRIGHT => aux_right()
//
| _ (* ignored *) => ()
//
) (* end of [fwork_keycode] *)

in (* in-of-local *)

val () = theKeyDowns_handle(lam(c) => fwork_keycode(c))

end // end of [local]

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

%{$
//
function
mygame_initize()
{
  var _ = my_dynload()
}
//
%} // end of [%{$]

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

(* end of [mygame.dats] *)

(*
** SpaceInvaders
*)

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

#define ATS_MAINATSFLAG 1
#define ATS_DYNLOADNAME "my_dynload"

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
(* ****** ****** *)
//
#include
"{$LIBATSCC2JS}/staloadall.hats"
//
(* ****** ****** *)
//
staload
"{$LIBATSCC2JS}/SATS/Bacon.js/baconjs.sats"
//
(* ****** ****** *)

abstype JSevent

(* ****** ****** *)
//
%{^
function
JSevent_keyCode(x){ return x.keyCode; }
%} // end of ...
//
extern
fun
JSevent_keyCode(x: JSevent): int = "mac#"
//
(* ****** ****** *)
//
%{^
//
var
theKeyDowns =
  $(document).asEventStream("keydown")
//
%} // end of ...
//
(* ****** ****** *)

#define KUP 38
#define KDOWN 40
#define KLEFT 37
#define KRIGHT 39

(* ****** ****** *)
//
extern
fun
theKeyDowns_handle
  (fwork: int -<cloref1> void): void
//
(* ****** ****** *)

local
//
val
theKeyDowns =
  $extval(EStream(JSevent), "theKeyDowns")
//
val
theKeyCodes =
  theKeyDowns.map(lam(x) =<cloref1> JSevent_keyCode(x))
//
in (* in-of-local *)

implement
theKeyDowns_handle(fwork) = theKeyCodes.onValue(fwork)

end // end of [local]

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

abstype player

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

extern
fun
player_new (): player = "mac#"

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

extern
fun
player_incby_x (player, x: int): void = "mac#"
extern
fun
player_incby_y (player, y: int): void = "mac#"

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

local

fun aux_up(): void = alert("UP")
fun aux_down(): void = alert("DOWN")
fun aux_left(): void = alert("LEFT")
fun aux_right(): void = alert("RIGHT")

fun
fwork_keycode(c: int) =
(
case+ 0 of
//
| _ when c = KUP => aux_up()
| _ when c = KDOWN => aux_down()
| _ when c = KLEFT => aux_left()
| _ when c = KRIGHT => aux_right()
//
| _ (* ignored *) => ()
//
) (* end of [fwork_keycode] *)

in (* in-of-local *)

val () = theKeyDowns_handle(lam(c) => fwork_keycode(c))

end // end of [local]

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

%{$
//
function
mygame_initize()
{
  var _ = my_dynload()
}
//
%} // end of [%{$]

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

(* end of [mygame.dats] *)


Updating: very minorly improving

Updating: very minorly improving

(*
** Project Euler: P1
** See https://projecteuler.net
*)
(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTcom
// Start time: January 13, 2015
//
(* ****** ****** *)
//
#include "share/atspre_define.hats"
//
(* ****** ****** *)
//
staload
"{$LIBATSHWXI}/PEULER/SATS/peuler.sats"
//
(* ****** ****** *)

fun
nmod
{n,p:int |
 n >= 0; p > 0}
(
  n: int n, p: int p
) :<> [r:nat] (MOD (n, p, r) | int r)
  = "mac#atspre_g0int_mod_int"
// end of [nmod]

(* ****** ****** *)
//
// SUM35 (n, t) =
// sum of i <= n such that i mod 3 = 0 or i mod 5 = 0
//
dataprop SUM35
(
  int(*n*), int(*t*)
) =
  | SUM35bas (0, 0) of ()
  | {n:pos}{s1:nat}
    SUM35ind1 (n, s1+n) of (SUM35 (n-1, s1), MOD (n, 3, 0))
  | {n:pos}{s1:nat}
    SUM35ind2 (n, s1+n) of (SUM35 (n-1, s1), MOD (n, 5, 0))
  | {n:pos}{s1:nat}{r3,r5:pos}
    SUM35ind3 (n, s1) of (SUM35 (n-1, s1), MOD (n, 3, r3), MOD (n, 5, r5))
// end of [SUM35]

(* ****** ****** *)
//
// HX-2015-01-13:
// please implement this one
//
fun sum35 {n:nat} (n: int n): [t:nat] (SUM35 (n, t) | int t)
//
(* ****** ****** *)

(* end of [P1.sats] *)


minor cleanup

minor cleanup

(**
  Some examples that implement and prove correctness of
  bit twiddling hacks from the following page.

  https://graphics.stanford.edu/~seander/bithacks.html
*)

staload "contrib/libats-/wdblair/patsolve/SATS/bitvector.sats"
staload "contrib/libats-/wdblair/prelude/SATS/integer.sats"

(**
  Assume we're only working with 32 bit numbers in this file.
*)
macdef int2bv = bv32_of_int
macdef bool2bv = bv32_of_bool

fun
min {x,y:bv32} (
  x: int (x), y: int (y)
): int (min(x, y)) =
  y lxor ((x lxor y) land ~bool2bv (x < y))

fun
max {x,y:bv32} (
  x: int (x), y: int (y)
): int (max(x, y)) =
 x lxor ((x lxor y) land ~bool2bv(x < y))

fun
cond_set_or_clear {f:bool} {w,m:bv32} (
  f: bool (f),
  w: &int (w) >> int (cond_set_or_clear(bv32(f), w, m)),
  m: int (m)
): void = {
  val () = w := w lxor ((~bool2bv(f) lxor w) land m)
}

fun
swap {x,y:bv32} (
  x: &int (x) >> int (y), y: &int (y) >> int (x)
): void = {
  val () =  x := x lxor y
  val () =  y := y lxor x
  val () =  x := x lxor y
}

fun
swap_bits {b:bv32} {i,j,n:nat | abs(i - j) >  n} (
  b: int (b), i: int i, j: int j, n: int n
): int (swap (b, bv32(i), bv32(j), bv32(n))) = let
  val i = int2bv (i)
  val j = int2bv (j)
  val n = int2bv (n)
  val one = int2bv(1)
  //
  val mask = (one << n) - one
  val x = ((b >> i) lxor (b >> j)) land mask
  val r = b lxor ((x << i) lor (x << j))
  //
in
  r
end

fun
is_power_of_two {x:bv32} (
  x: int(x)
): bool (is_power_of_2 (x)) =
  if x = 0 then
    false
  else
    ((x land (x - 1)) = 0)

fun
has_zero_byte {x:bv32} (
  x: int (x)
): bool (has_zero_byte(x)) =
  ~(((x - 0x01010101) land (lnot(x) land 0x80808080)) = 0)

fun
has_byte {x,n:bv32 | ule (n, bv32(0xff))} (
  x: int (x), n: int (n)
): bool (has_byte(x, n)) = let
  val mask = udiv(lnot (0), 0xff) // 0x01010101
  val test = x lxor (mask * n)
in
  has_zero_byte (test)
end

(**
  Encoding Brian Kernighan's Bit Counting Routine in ATS.
*)
stacst bits_set_bv32: bv32 -> int
stadef bits_set = bits_set_bv32

dataprop BitCount (b:bv32, bv32, int) =
  | Nil (b, b, 0) of ()
  | {x:bv32 | ugt(x, bv32(0))} {n:int}
    Succ (b, x land (x - bv32(1)), n + 1) of BitCount (b, x, n)

extern praxi
bitcount_elim_lemma {b:bv32} {n:int} (
  BitCount (b, bv32(0), n)
): [bits_set (b) == n] void

fun
bits_set {b:bv32} (
  b: int b
): int (bits_set(b)) = let
  //
  fun loop {x:bv32} {n:int} (
    pf: BitCount (b, x, n) | x: int (x), c: int (n)
  ): int (bits_set(b)) =
    if x = 0 then let
      prval () = bitcount_elim_lemma (pf)
    in
      c
    end
    else
      loop (Succ (pf) | x land (x - 1), succ(c))
  //
in
  loop (Nil() | b, 0)
end

(**
  Some examples that implement and prove correctness of
  bit twiddling hacks from the following page.

  https://graphics.stanford.edu/~seander/bithacks.html
*)

staload "contrib/libats-/wdblair/patsolve/SATS/bitvector.sats"
staload "contrib/libats-/wdblair/prelude/SATS/integer.sats"

(**
  Assume we're only working with 32 bit numbers in this file.
*)
macdef int2bv = bv32_of_int
macdef bool2bv = bv32_of_bool

fun
min {x,y:bv32} (
  x: int (x), y: int (y)
): int (min(x, y)) =
  y lxor ((x lxor y) land ~bool2bv (x < y))

fun
max {x,y:bv32} (
  x: int (x), y: int (y)
): int (max(x, y)) =
 x lxor ((x lxor y) land ~bool2bv(x < y))

fun
cond_set_or_clear {f:bool} {w,m:bv32} (
  f: bool (f),
  w: &int (w) >> int (cond_set_or_clear(bv32(f), w, m)),
  m: int (m)
): void = {
  val () = w := w lxor ((~bool2bv(f) lxor w) land m)
}

fun
swap {x,y:bv32} (
  x: &int (x) >> int (y), y: &int (y) >> int (x)
): void = {
  val () =  x := x lxor y
  val () =  y := y lxor x
  val () =  x := x lxor y
}

fun
swap_bits {b:bv32} {i,j,n:nat | abs(i - j) >  n} (
  b: int (b), i: int i, j: int j, n: int n
): int (swap (b, bv32(i), bv32(j), bv32(n))) = let
  val i = int2bv (i)
  val j = int2bv (j)
  val n = int2bv (n)
  val one = int2bv(1)
  //
  val mask = (one << n) - one
  val x = ((b >> i) lxor (b >> j)) land mask
  val r = b lxor ((x << i) lor (x << j))
  //
in
  r
end

fun
is_power_of_two {x:bv32} (
  x: int(x)
): bool (is_power_of_2 (x)) =
  if x = 0 then
    false
  else
    ((x land (x - 1)) = 0)

fun
has_zero_byte {x:bv32} (
  x: int (x)
): bool (has_zero_byte(x)) =
  ~(((x - 0x01010101) land (lnot(x) land 0x80808080)) = 0)

fun
has_byte {x,n:bv32 | ule (n, bv32(0xff))} (
  x: int (x), n: int (n)
): bool (has_byte(x, n)) = let
  val mask = udiv(lnot (0), 0xff) // 0x01010101
  val test = x lxor (mask * n)
in
  has_zero_byte (test)
end

(**
  Encoding Brian Kernighan's Bit Counting Routine in ATS.

*)
stacst bits_set_bv32: bv32 -> int
stadef bits_set = bits_set_bv32

dataprop BitCount (b:bv32, bv32, int) =
  | Nil (b, b, 0) of ()
  | {x:bv32 | ugt(x, bv32(0))} {n:int}
    Succ (b, x land (x - bv32(1)), n + 1) of BitCount (b, x, n)

extern praxi
bitcount_elim_lemma {b:bv32} {n:int} (
  BitCount (b, bv32(0), n)
): [bits_set (b) == n] void

fun
bits_set {b:bv32} (
  b: int b
): int (bits_set(b)) = let
  //
  fun loop {x:bv32} {n:int} (
    pf: BitCount (b, x, n) | x: int (x), c: int (n)
  ): int (bits_set(b)) =
    if x = 0 then let
      prval () = bitcount_elim_lemma (pf)
    in
      c
    end
    else let
      prval pff = Succ (pf)
    in
      loop (pff | x land (x - 1), succ(c))
    end
  //
in
  loop (Nil() | b, 0)
end


Updating: very very minorly

Updating: very very minorly

(*
** libatscc-common
*)

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

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

(* ****** ****** *)
//
implement
int_repeat_lazy
  (n0, f) =
  int_repeat_cloref(n0, lazy2cloref(f))
//
(* ****** ****** *)

implement
int_repeat_cloref
  (n0, fwork) = let
//
fun
loop
(
  n: int, fwork: cfun0(void)
) : void = (
//
if n > 0
  then (fwork(); loop(n-1, fwork)) else ()
//
) (* end of [loop] *)
//
in
  loop (n0, fwork)
end // end of [int_repeat_cloref]

(* ****** ****** *)
//
implement
int_exists_cloref
  (n0, pred) =
(
  intrange_exists_cloref(0, n0, pred)
)
implement
int_forall_cloref
  (n0, pred) =
(
  intrange_forall_cloref (0, n0, pred)
)
//
implement
int_foreach_cloref
  (n0, pred) =
(
  intrange_foreach_cloref (0, n0, pred)
)
//
(* ****** ****** *)
//
implement
int_exists_method
  (n0) = lam(f) => int_exists_cloref(n0, f)
implement
int_forall_method
  (n0) = lam(f) => int_forall_cloref(n0, f)
//
implement
int_foreach_method
  (n0) = lam(f) => int_foreach_cloref(n0, f)
//
(* ****** ****** *)
//
implement
int_foldleft_cloref
  {res}
  (n0, ini, fopr) =
  intrange_foldleft_cloref{res}(0, n0, ini, fopr)
//
implement
int_foldleft_method
  {res}(n0, ini) =
  lam(fopr) => int_foldleft_cloref{res}(n0, ini, fopr)
//
(* ****** ****** *)
//
implement
int_list_map_cloref
  {a}{n}(n0, fopr) = let
//
fun
aux
{ i:nat
| i <= n
} (i: int(i)): list(a, n-i) = (
//
if
(i < n0)
then list_cons(fopr(i), aux(i+1)) else list_nil()
// end of [if]
)
//
in
  aux(0)
end // end of [int_list_map_cloref]
//
implement
int_list_map_method
  {a}{n}(n0, tres) =
  lam(fopr) => int_list_map_cloref{a}{n}(n0, fopr)
//
(* ****** ****** *)
//
implement
int2_exists_cloref
  (n1, n2, pred) =
(
  intrange2_exists_cloref (0, n1, 0, n2, pred)
)
implement
int2_forall_cloref
  (n1, n2, pred) =
(
  intrange2_forall_cloref (0, n1, 0, n2, pred)
)
//
implement
int2_foreach_cloref
  (n1, n2, pred) =
(
  intrange2_foreach_cloref (0, n1, 0, n2, pred)
)
//
(* ****** ****** *)

implement
intrange_exists_cloref
  (l, r, pred) = let
//
fun
loop
(
  l: int, r: int, pred: cfun1(int, bool)
) : bool = (
//
if l < r
  then (
    if pred(l) then true else loop (l+1, r, pred)
  ) else false
//
) (* end of [loop] *)
//
in
  loop (l, r, pred)
end // end of [intrange_exists_cloref]

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

implement
intrange_forall_cloref
  (l, r, pred) = let
//
fun
loop
(
  l: int, r: int, pred: cfun1(int, bool)
) : bool = (
//
if l < r
  then (
    if pred(l) then loop(l+1, r, pred) else false
  ) else true
//
) (* end of [loop] *)
//
in
  loop (l, r, pred)
end // end of [intrange_forall_cloref]

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

implement
intrange_foreach_cloref
  (l, r, fwork) = let
//
fun
loop
(
  l: int, r: int, fwork: cfun1(int, void)
) : void = (
//
if l < r
  then let val () = fwork(l) in loop(l+1, r, fwork) end
  else ()
//
) (* end of [loop] *)
//
in
  loop(l, r, fwork)
end // end of [intrange_foreach_cloref]

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

implement
intrange_foldleft_cloref
  {res}
  (l, r, ini, fopr) = let
//
fun
loop
(
  l: int, r: int
, ini: res, f: cfun2(res, int, res)
) : res = (
//
if l < r then loop(l+1, r, f(ini, l), fopr) else ini
//
) (* end of [loop] *)
//
in
  loop(l, r, ini, fopr)
end // end of [intrange_foldleft_cloref]

(* ****** ****** *)
//
implement
intrange_foldleft_method
  {res}
  ( $tup(l, r), ini ) =
(
  lam(fopr) =>
    intrange_foldleft_cloref{res}(l, r, ini, fopr)
  // end of [lam]
)
//
(* ****** ****** *)

implement
intrange2_exists_cloref
  (l1_, r1_, l2_, r2_, pred) = let
//
// HX-2016-07-26:
// loop1 and loop2 need to have
// the same number of arguments
// in order to support atscc2clj
//
fnx
loop1
(
  l1: int, r1: int
, l2: int, r2: int
, f: cfun2 (int, int, bool)
) : bool = (
//
if l1 < r1
  then loop2(l1, r1, l2, r2, pred) else false
//
) (* end of [loop1] *)
//
and
loop2
(
  l1: int, r1: int
, l2: int, r2: int
, pred: cfun2 (int, int, bool)
) : bool = (
//
if (
l2 < r2
) then (
//
if (
pred(l1, l2)
) then true
  else loop2(l1, r1, l2+1, r2, pred)
// end of [if]
) else loop1(l1+1, r1, l2_, r2_, pred)
//
) (* end of [loop2] *)
//
in
  loop1(l1_, r1_, l2_, r2_, pred)
end // end of [intrange2_exists_cloref]

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

implement
intrange2_forall_cloref
  (l1_, r1_, l2_, r2_, pred) = let
//
// HX-2016-07-26:
// loop1 and loop2 need to have
// the same number of arguments
// in order to support atscc2clj
//
fnx
loop1
(
  l1: int, r1: int
, l2: int, r2: int
, pred: cfun2 (int, int, bool)
) : bool = (
//
if l1 < r1
  then loop2 (l1, r1, l2, r2, pred) else true
//
) (* end of [loop1] *)
//
and
loop2
(
  l1: int, r1: int
, l2: int, r2: int
, pred: cfun2 (int, int, bool)
) : bool = (
//
if (
l2 < r2
) then
(
if (
pred(l1, l2)
) then loop2(l1, r1, l2+1, r2, pred)
  else false
// end of [if]
) else loop1(l1+1, r1, l2_, r2_, pred)
//
) (* end of [loop2] *)
//
in
  loop1 (l1_, r1_, l2_, r2_, pred)
end // end of [intrange2_forall_cloref]

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

implement
intrange2_foreach_cloref
  (l1_, r1_, l2_, r2_, fwork) = let
//
// HX-2016-07-26:
// loop1 and loop2 need to have
// the same number of arguments
// in order to support atscc2clj
//
fnx
loop1
(
  l1: int, r1: int
, l2: int, r2: int
, fwork: cfun2 (int, int, void)
) : void = (
//
if l1 < r1
  then loop2(l1, r1, l2, r2, fwork)
  else ((*void*))
//
) (* end of [loop1] *)
//
and
loop2
(
  l1: int, r1: int
, l2: int, r2: int
, fwork: cfun2 (int, int, void)
) : void = (
//
if (
l2 < r2
) then (
//
fwork(l1, l2);
loop2(l1, r1, l2+1, r2, fwork)
//
) else (
  loop1(succ(l1), r1, l2_, r2_, fwork)
) (* end of [else] *)
//
) (* end of [loop2] *)
//
in
  loop1 (l1_, r1_, l2_, r2_, fwork)
end // end of [intrange2_foreach_cloref]

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

(* end of [intrange.dats] *)

(*
** libatscc-common
*)

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

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

(* ****** ****** *)
//
implement
int_repeat_lazy
  (n0, f) =
  int_repeat_cloref(n0, lazy2cloref(f))
//
(* ****** ****** *)

implement
int_repeat_cloref
  (n0, fwork) = let
//
fun
loop
(
  n: int, fwork: cfun0(void)
) : void = (
//
if n > 0
  then (fwork(); loop(n-1, fwork)) else ()
//
) (* end of [loop] *)
//
in
  loop (n0, fwork)
end // end of [int_repeat_cloref]

(* ****** ****** *)
//
implement
int_exists_cloref
  (n0, pred) =
(
  intrange_exists_cloref(0, n0, pred)
)
implement
int_forall_cloref
  (n0, pred) =
(
  intrange_forall_cloref (0, n0, pred)
)
//
implement
int_foreach_cloref
  (n0, pred) =
(
  intrange_foreach_cloref (0, n0, pred)
)
//
(* ****** ****** *)
//
implement
int_exists_method
  (n0) = lam(f) => int_exists_cloref(n0, f)
implement
int_forall_method
  (n0) = lam(f) => int_forall_cloref(n0, f)
//
implement
int_foreach_method
  (n0) = lam(f) => int_foreach_cloref(n0, f)
//
(* ****** ****** *)
//
implement
int_foldleft_cloref
  {res}
  (n0, ini, fopr) =
  intrange_foldleft_cloref{res}(0, n0, ini, fopr)
//
implement
int_foldleft_method
  {res}(n0, ini) =
  lam(fopr) => int_foldleft_cloref{res}(n0, ini, fopr)
//
(* ****** ****** *)
//
implement
int_list_map_cloref
  {a}{n}(n0, fopr) = let
//
fun
aux
{ i:nat
| i <= n
} (i: int(i)): list(a, n-i) = (
//
if
(i < n0)
then list_cons(fopr(i), aux(i+1)) else list_nil()
// end of [if]
)
//
in
  aux(0)
end // end of [int_list_map_cloref]
//
implement
int_list_map_method
  {a}{n}(n0, tres) =
  lam(fopr) => int_list_map_cloref{a}{n}(n0, fopr)
//
(* ****** ****** *)
//
implement
int2_exists_cloref
  (n1, n2, pred) =
(
  intrange2_exists_cloref (0, n1, 0, n2, pred)
)
implement
int2_forall_cloref
  (n1, n2, pred) =
(
  intrange2_forall_cloref (0, n1, 0, n2, pred)
)
//
implement
int2_foreach_cloref
  (n1, n2, pred) =
(
  intrange2_foreach_cloref (0, n1, 0, n2, pred)
)
//
(* ****** ****** *)

implement
intrange_exists_cloref
  (l, r, pred) = let
//
fun
loop
(
  l: int, r: int, pred: cfun1(int, bool)
) : bool = (
//
if l < r
  then (
    if pred(l) then true else loop (l+1, r, pred)
  ) else false
//
) (* end of [loop] *)
//
in
  loop (l, r, pred)
end // end of [intrange_exists_cloref]

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

implement
intrange_forall_cloref
  (l, r, pred) = let
//
fun
loop
(
  l: int, r: int, pred: cfun1(int, bool)
) : bool = (
//
if l < r
  then (
    if pred(l) then loop(l+1, r, pred) else false
  ) else true
//
) (* end of [loop] *)
//
in
  loop (l, r, pred)
end // end of [intrange_forall_cloref]

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

implement
intrange_foreach_cloref
  (l, r, fwork) = let
//
fun
loop
(
  l: int, r: int, fwork: cfun1(int, void)
) : void = (
//
if l < r
  then let val () = fwork(l) in loop(l+1, r, fwork) end
  else ()
//
) (* end of [loop] *)
//
in
  loop(l, r, fwork)
end // end of [intrange_foreach_cloref]

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

implement
intrange_foldleft_cloref
  {res}
  (l, r, ini, fopr) = let
//
fun
loop
(
  l: int, r: int
, ini: res, f: cfun2(res, int, res)
) : res = (
//
if l < r then loop(l+1, r, f(ini, l), fopr) else ini
//
) (* end of [loop] *)
//
in
  loop(l, r, ini, fopr)
end // end of [intrange_foldleft_cloref]

(* ****** ****** *)
//
implement
intrange_foldleft_method
  {res}
  ( $tup(l, r), ini ) =
(
  lam(fopr) =>
    intrange_foldleft_cloref{res}(l, r, ini, fopr)
  // end of [lam]
)
//
(* ****** ****** *)

implement
intrange2_exists_cloref
  (l1_, r1_, l2_, r2_, pred) = let
//
fnx
loop1
(
  l1: int, r1: int
, l2: int, r2: int
, f: cfun2 (int, int, bool)
) : bool = (
//
if l1 < r1
  then loop2(l1, r1, l2, r2, pred) else false
//
) (* end of [loop1] *)
//
and
loop2
(
  l1: int, r1: int
, l2: int, r2: int
, pred: cfun2 (int, int, bool)
) : bool = (
//
if (
l2 < r2
) then (
//
if (
pred(l1, l2)
) then true
  else loop2(l1, r1, l2+1, r2, pred)
// end of [if]
) else loop1(l1+1, r1, l2_, r2_, pred)
//
) (* end of [loop2] *)
//
in
  loop1(l1_, r1_, l2_, r2_, pred)
end // end of [intrange2_exists_cloref]

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

implement
intrange2_forall_cloref
  (l1_, r1_, l2_, r2_, pred) = let
//
fnx
loop1
(
  l1: int, r1: int
, l2: int, r2: int
, pred: cfun2 (int, int, bool)
) : bool = (
//
if l1 < r1
  then loop2 (l1, r1, l2, r2, pred) else true
//
) (* end of [loop1] *)
//
and
loop2
(
  l1: int, r1: int
, l2: int, r2: int
, pred: cfun2 (int, int, bool)
) : bool = (
//
if (
l2 < r2
) then
(
if (
pred(l1, l2)
) then loop2(l1, r1, l2+1, r2, pred)
  else false
// end of [if]
) else loop1(l1+1, r1, l2_, r2_, pred)
//
) (* end of [loop2] *)
//
in
  loop1 (l1_, r1_, l2_, r2_, pred)
end // end of [intrange2_forall_cloref]

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

implement
intrange2_foreach_cloref
  (l1_, r1_, l2_, r2_, fwork) = let
//
fnx
loop1
(
  l1: int, r1: int
, l2: int, r2: int
, fwork: cfun2 (int, int, void)
) : void = (
//
if l1 < r1
  then loop2(l1, r1, l2, r2, fwork)
  else ((*void*))
//
) (* end of [loop1] *)
//
and
loop2
(
  l1: int, r1: int
, l2: int, r2: int
, fwork: cfun2 (int, int, void)
) : void = (
//
if (
l2 < r2
) then (
//
fwork(l1, l2);
loop2(l1, r1, l2+1, r2, fwork)
//
) else (
  loop1(succ(l1), r1, l2_, r2_, fwork)
) (* end of [else] *)
//
) (* end of [loop2] *)
//
in
  loop1 (l1_, r1_, l2_, r2_, fwork)
end // end of [intrange2_foreach_cloref]

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

(* end of [intrange.dats] *)


Adding note to jsmn module

Adding note to jsmn module

%{#
#include "contrib/libats-/wdblair/jsmn/CATS/jsmn.cats"
%}

(**
    Will Blair
    December 2015
*)

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

#define
ATS_PACKNAME "ATSCNTRB.jsmn"
#define
ATS_EXTERN_PREFIX "atscntrb_jsmn_" // prefix for external names

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

typedef jsmntype_t = int

macdef JSMN_PRIMITIVE = $extval(jsmntype_t, "JSMN_PRIMITIVE")
macdef JSMN_OBJECT = $extval(jsmntype_t, "JSMN_OBJECT")
macdef JSMN_ARRAY = $extval(jsmntype_t, "JSMN_ARRAY")
macdef JSMN_STRING = $extval(jsmntype_t, "JSMN_STRING")

typedef jsmnerr_t = int

(** Not enough tokens were provided *)
macdef JSMN_ERROR_NOMEM = $extval(jsmnerr_t, "JSMN_ERROR_NOMEM")
(** Invalid character inside JSON string *)
macdef JSMN_ERROR_INVAL = $extval(jsmnerr_t, "JSMN_ERROR_INVAL")
(** The string is not a full JSON packet, more bytes expected *)
macdef JSMN_ERROR_PART = $extval(jsmnerr_t, "JSMN_ERROR_PART")

abst@ype jsmn_parser = $extype "jsmn_parser"
abst@ype jsmntok_t = $extype "jsmntok_t"

abst@ype jsmntokptr = $extype "jsmntok_t*"

fun jsmn_init (&jsmn_parser? >> _): void = "mac#%"

fun jsmn_parse {k,l:addr} {m,n:int} (
    !bytes m @ k, !bytes (sizeof(jsmntok_t)*n) @ l |
        &jsmn_parser, ptr k, size_t m, ptr l, uint n
): jsmnerr_t = "mac#%"

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

fun jsmntok_type (jsmntokptr): jsmntype_t = "mac#%"

overload .type with jsmntok_type

fun jsmntok_size (jsmntokptr): int = "mac#%"

fun jsmntok_start (jsmntokptr): int = "mac#%"

overload .start with jsmntok_start

fun jsmntok_end (jsmntokptr): int = "mac#%"

(**
  The end keyword is reserved.
*)
overload .ending with jsmntok_end

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

(**
    Intended as a way to easily get the source string associated with
    a jsmn token.
*)
fun{}
jsmn_src (): string

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

fun
jsmntokptr_numtokens(jsmntokptr): int

overload .numtokens with jsmntokptr_numtokens

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

// end of [jsmn]

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

%{#
#include "contrib/libats-/wdblair/jsmn/CATS/jsmn.cats"
%}

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

#define
ATS_PACKNAME "ATSCNTRB.jsmn"
#define
ATS_EXTERN_PREFIX "atscntrb_jsmn_" // prefix for external names

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

typedef jsmntype_t = int

macdef JSMN_PRIMITIVE = $extval(jsmntype_t, "JSMN_PRIMITIVE")
macdef JSMN_OBJECT = $extval(jsmntype_t, "JSMN_OBJECT")
macdef JSMN_ARRAY = $extval(jsmntype_t, "JSMN_ARRAY")
macdef JSMN_STRING = $extval(jsmntype_t, "JSMN_STRING")

typedef jsmnerr_t = int

(** Not enough tokens were provided *)
macdef JSMN_ERROR_NOMEM = $extval(jsmnerr_t, "JSMN_ERROR_NOMEM")
(** Invalid character inside JSON string *)
macdef JSMN_ERROR_INVAL = $extval(jsmnerr_t, "JSMN_ERROR_INVAL")
(** The string is not a full JSON packet, more bytes expected *)
macdef JSMN_ERROR_PART = $extval(jsmnerr_t, "JSMN_ERROR_PART")

abst@ype jsmn_parser = $extype "jsmn_parser"
abst@ype jsmntok_t = $extype "jsmntok_t"

abst@ype jsmntokptr = $extype "jsmntok_t*"

fun jsmn_init (&jsmn_parser? >> _): void = "mac#%"

fun jsmn_parse {k,l:addr} {m,n:int} (
    !bytes m @ k, !bytes (sizeof(jsmntok_t)*n) @ l |
        &jsmn_parser, ptr k, size_t m, ptr l, uint n
): jsmnerr_t = "mac#%"

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

fun jsmntok_type (jsmntokptr): jsmntype_t = "mac#%"

overload .type with jsmntok_type

fun jsmntok_size (jsmntokptr): int = "mac#%"

fun jsmntok_start (jsmntokptr): int = "mac#%"

overload .start with jsmntok_start

fun jsmntok_end (jsmntokptr): int = "mac#%"

(**
  The end keyword is reserved.
*)
overload .ending with jsmntok_end

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

(**
    Intended as a way to easily get the source string associated with
    a jsmn token.
*)
fun{}
jsmn_src (): string

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

fun
jsmntokptr_numtokens(jsmntokptr): int

overload .numtokens with jsmntokptr_numtokens

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

// end of [jsmn]

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


Updating: hello-1.dats is working

Updating: hello-1.dats is working

(*
** Following lkmpg/hello-1.c
*)

(* ****** ****** *)
//
// HX-2014-10-22:
// nothing fancy here;
// just trying to get it working
//
(* ****** ****** *)
//
// HX-2014-10-21:
// no use for dynloading
//
#define ATS_DYNLOADFLAG 0
//
(* ****** ****** *)

%{^
#include <linux/init.h>
#include <linux/module.h>
#include <linux/kernel.h>
%} // end of [%{^]

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

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

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

%{^
//
#ifdef ATSPMVstring
#undef ATSPMVstring
#endif // ATSPMVstring
//
#define ATSPMVstring(x) x
//
#define KERN_INFO_(x) (KERN_INFO x)
#define KERN_ALERT_(x) (KERN_ALERT x)
%} // end of [%{^]

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

typedef interr = int

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

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

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

extern
fun KERN_INFO_(x: string): string = "mac#"
extern
fun KERN_ALERT_(x: string): string = "mac#"

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

implement
init_module
(
) = 0 where
{
//
val () =
$extfcall
(
  void, "printk", KERN_ALERT_"Hello(1) from ATS!\n"
) (* end of [val] *)
//
} (* end of [init_module] *)

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

implement
cleanup_module
(
) = () where
{
val () =
$extfcall
(
  void, "printk", KERN_ALERT_"Goodbye(1) from ATS!\n"
) (* end of [val] *)
} (* end of [cleanup_module] *)

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

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

(*
** Following lkmpg/hello-1.c
*)

(* ****** ****** *)
//
// HX-2014-10-22:
// nothing fancy here;
// just trying to get it working
//
(* ****** ****** *)
//
// HX-2014-10-21:
// no use for dynloading
//
#define ATS_DYNLOADFLAG 0
//
(* ****** ****** *)

%{^
#include <linux/init.h>
#include <linux/module.h>
#include <linux/kernel.h>
%} // end of [%{^]

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

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

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

%{^
//
#ifdef ATSPMVstring
#undef ATSPMVstring
#endif // ATSPMVstring
//
#define ATSPMVstring(x) x
//
#define KERN_INFO_(x) (KERN_INFO x)
#define KERN_ALERT_(x) (KERN_ALERT x)
%} // end of [%{^]

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

typedef interr = int

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

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

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

extern
fun KERN_INFO_(x: string): string = "mac#"
extern
fun KERN_ALERT_(x: string): string = "mac#"

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

implement
init_module
(
) = 0 where
{
//
val () =
$extfcall
(
  void, "printk", KERN_ALERT_"Hello world 1.\n"
) (* end of [val] *)
//
} (* end of [init_module] *)

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

implement
cleanup_module
(
) = () where
{
val () =
$extfcall
(
  void, "printk", KERN_ALERT_"Goodbye world 1.\n"
) (* end of [val] *)
} (* end of [cleanup_module] *)

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

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


Updating: very minorly improving

Updating: very minorly improving

(*
** Erathosthene's sieve
*)

(* ****** ****** *)
%{^
//
#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_colist(a:vt@ype)
//
(* ****** ****** *)
//
datatype
chan1pos_list
  (a:vt@ype, type) =
| chan1pos_list_nil(a, nil) of ()
| chan1pos_list_cons(a, snd(a) :: ssn_colist(a)) of ()
//
(* ****** ****** *)
//
extern
fun{}
chan1pos_list
  {a:vt@ype}
(
  !chan1pos(ssn_colist(a)) >> chan1pos(ssn)
) : #[ssn:type] chan1pos_list(a, ssn)
//
(* ****** ****** *)
//
extern
fun{}
chan1neg_list_nil
  {a:vt@ype}
  (!chan1neg(ssn_colist(a)) >> chan1neg(nil)): void
extern
fun{}
chan1neg_list_cons
  {a:vt@ype}
  (!chan1neg(ssn_colist(a)) >> chan1neg(snd(a)::ssn_colist(a))): void
//
(* ****** ****** *)

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

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

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

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

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

(* ****** ****** *)
//
extern
fun
ints_from (n: int): chan1neg(ssn_colist(int))
//
extern
fun
ints_filter
  (chan1neg(ssn_colist(int)), n: int): chan1neg(ssn_colist(int))
//
(* ****** ****** *)

implement
ints_from (n) = let
//
fun
fserv
(
  chp: chan1pos(ssn_colist(int)), n: int
) : void = let
//
val opt = chan1pos_list (chp)
//
in
//
case+ opt of
| chan1pos_list_nil() =>
    channel1_close(chp)
| chan1pos_list_cons() =>
    (chan1pos_send<int>(chp, n); fserv(chp, n+1))
//
end // end of [fserv]
//
in
  chan1neg_create_exn(llam(chp) => fserv(chp, n))
end // end of [ints_from]

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

implement
ints_filter
  (chn, n0) = let
//
fun
getfst
(
  chn: !chan1neg(ssn_colist(int))
) : int = let
//
val () =
  chan1neg_list_cons(chn)
//
val fst = chan1neg_send_val(chn)
//
in
  if fst mod n0 > 0 then fst else getfst(chn)
end // end of [getfst]
//
fun
fserv
(
  chp: chan1pos(ssn_colist(int))
, chn: chan1neg(ssn_colist(int))
) : void = let
//
val opt = chan1pos_list (chp)
//
in
//
case+ opt of
| chan1pos_list_nil() =>
  (
    channel1_close(chp);
    chan1neg_list_nil(chn); channel1_close(chn)
  )
| chan1pos_list_cons() =>
  (
    chan1pos_send(chp, getfst(chn)); fserv(chp, chn)
  )
//
end // end of [fserv]
//
in
  chan1neg_create_exn(llam(chp) => fserv(chp, chn))
end // end of [ints_filter]

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

extern
fun
primes_gen(): chan1neg(ssn_colist(int))

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

implement
primes_gen() = let
//
fun
fserv
(
  chp: chan1pos(ssn_colist(int))
, chn: chan1neg(ssn_colist(int))
) : void = let
//
val opt = chan1pos_list (chp)
//
in
//
case+ opt of
| chan1pos_list_nil() =>
  (
    channel1_close(chp);
    chan1neg_list_nil(chn); channel1_close(chn)
  )
| chan1pos_list_cons() => let
    val () =
      chan1neg_list_cons(chn)
    // end of [val]
    val p0 = chan1neg_send_val(chn)
  in
    chan1pos_send(chp, p0); fserv(chp, ints_filter(chn, p0))
  end // end of [chan1neg_list_cons]
//
end // end of [fserv]
//
in
  chan1neg_create_exn(llam(chp) => fserv(chp, ints_from(2)))
end // end of [primes_gen]

(* ****** ****** *)
//
extern
fun
fprint_primes
  (out: FILEref, n: int, chn: !chan1neg(ssn_colist(int))): void
//
implement
fprint_primes
  (out, n, chn) =
(
if
n > 0
then let
//
val () =
  chan1neg_list_cons(chn)
// end of [val]
val px = chan1neg_send_val<int> (chn)
val () = fprintln! (out, px)
//
in
  fprint_primes (out, n-1, chn)
end // end of [then]
else () // end of [else]
) (* end of [fprint_primes] *)
//
(* ****** ****** *)

fun
wait_for_closing
  (N: int): void = let
//
fun log (N: int, n: int, i: int): int =
  if n >= N then i else log(N, n+n, i+1)
//
fun
loop
(
  n: int
) : void =
if
n > 0
then let
  val _ = $UNISTD.usleep(250000u)
  val () = fprint(stdout_ref, ".")
  val () = fileref_flush(stdout_ref)
in
  loop (n-1)
end (* end of [if] *)
//
val () = loop(3+log(N/8, 1, 0))
val () = fprint_newline (stdout_ref)
//
in
  // nothing
end // end of [wait_for_closing]

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

implement
main0(argc, argv) =
{
//
val N =
(
//
if argc >= 2
  then g0string2int(argv[1]) else 10
//
) : int // end of [val]
//
val N = g1ofg0(N)
val () = assertloc (N >= 0)
//
val out = stdout_ref
//
val chn = primes_gen()
//
val () = fprint_primes(out, N, chn)
//
val () =
  chan1neg_list_nil(chn)
//
val () = channel1_close(chn)
//
val () =
print!
(
  "Waiting for the created threads to finish"
) (* end of [val] *)
//
val () = wait_for_closing(N)
//
} (* end of [main0] *)

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

(* end of [sieve.dats] *)

(*
** Erathosthene's sieve
*)

(* ****** ****** *)
%{^
//
#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_colist(a:vt@ype)
//
typedef colist(a:vt@ype) = ssn_colist(a)
//
(* ****** ****** *)
//
datatype
chan1pos_list
  (a:vt@ype, type) =
| chan1pos_list_nil(a, nil) of ()
| chan1pos_list_cons(a, snd(a) :: colist(a)) of ()
//
(* ****** ****** *)
//
extern
fun{}
chan1pos_list
  {a:vt@ype}
(
  !chan1pos(colist(a)) >> chan1pos(ssn)
) : #[ssn:type] chan1pos_list(a, ssn)
//
(* ****** ****** *)
//
extern
fun{}
chan1neg_list_nil
  {a:vt@ype}
  (!chan1neg(colist(a)) >> chan1neg(nil)): void
extern
fun{}
chan1neg_list_cons
  {a:vt@ype}
  (!chan1neg(colist(a)) >> chan1neg(snd(a)::colist(a))): void
//
(* ****** ****** *)

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

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

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

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

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

(* ****** ****** *)
//
extern
fun
ints_from (n: int): chan1neg(colist(int))
//
extern
fun
ints_filter
  (chan1neg(colist(int)), n: int): chan1neg(colist(int))
//
(* ****** ****** *)

implement
ints_from (n) = let
//
fun
fserv
(
  chp: chan1pos(colist(int)), n: int
) : void = let
//
val opt = chan1pos_list (chp)
//
in
//
case+ opt of
| chan1pos_list_nil() =>
    channel1_close(chp)
| chan1pos_list_cons() =>
    (chan1pos_send<int>(chp, n); fserv(chp, n+1))
//
end // end of [fserv]
//
in
  chan1neg_create_exn(llam(chp) => fserv(chp, n))
end // end of [ints_from]

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

implement
ints_filter
  (chn, n0) = let
//
fun
getfst
(
  chn: !chan1neg(colist(int))
) : int = let
//
val () =
  chan1neg_list_cons(chn)
//
val fst = chan1neg_send_val(chn)
//
in
  if fst mod n0 > 0 then fst else getfst(chn)
end // end of [getfst]
//
fun
fserv
(
  chp: chan1pos(colist(int))
, chn: chan1neg(colist(int))
) : void = let
//
val opt = chan1pos_list (chp)
//
in
//
case+ opt of
| chan1pos_list_nil() =>
  (
    channel1_close(chp);
    chan1neg_list_nil(chn); channel1_close(chn)
  )
| chan1pos_list_cons() =>
  (
    chan1pos_send(chp, getfst(chn)); fserv(chp, chn)
  )
//
end // end of [fserv]
//
in
  chan1neg_create_exn(llam(chp) => fserv(chp, chn))
end // end of [ints_filter]

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

extern
fun
primes_gen(): chan1neg(colist(int))

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

implement
primes_gen() = let
//
fun
fserv
(
  chp: chan1pos(colist(int))
, chn: chan1neg(colist(int))
) : void = let
//
val opt = chan1pos_list (chp)
//
in
//
case+ opt of
| chan1pos_list_nil() =>
  (
    channel1_close(chp);
    chan1neg_list_nil(chn); channel1_close(chn)
  )
| chan1pos_list_cons() => let
    val () =
      chan1neg_list_cons(chn)
    // end of [val]
    val p0 = chan1neg_send_val(chn)
  in
    chan1pos_send(chp, p0); fserv(chp, ints_filter(chn, p0))
  end // end of [chan1neg_list_cons]
//
end // end of [fserv]
//
in
  chan1neg_create_exn(llam(chp) => fserv(chp, ints_from(2)))
end // end of [primes_gen]

(* ****** ****** *)
//
extern
fun
fprint_primes
  (out: FILEref, n: int, chn: !chan1neg(colist(int))): void
//
implement
fprint_primes
  (out, n, chn) =
(
if
n > 0
then let
//
val () =
  chan1neg_list_cons(chn)
// end of [val]
val px = chan1neg_send_val<int> (chn)
val () = fprintln! (out, px)
//
in
  fprint_primes (out, n-1, chn)
end // end of [then]
else () // end of [else]
) (* end of [fprint_primes] *)
//
(* ****** ****** *)

fun
wait_for_closing
  (N: int): void = let
//
fun log (N: int, n: int, i: int): int =
  if n >= N then i else log(N, n+n, i+1)
//
fun
loop
(
  n: int
) : void =
if
n > 0
then let
  val _ = $UNISTD.usleep(250000u)
  val () = fprint(stdout_ref, ".")
  val () = fileref_flush(stdout_ref)
in
  loop (n-1)
end (* end of [if] *)
//
val () = loop(3+log(N/8, 1, 0))
val () = fprint_newline (stdout_ref)
//
in
  // nothing
end // end of [wait_for_closing]

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

implement
main0(argc, argv) =
{
//
val N =
(
//
if argc >= 2
  then g0string2int(argv[1]) else 10
//
) : int // end of [val]
//
val N = g1ofg0(N)
val () = assertloc (N >= 0)
//
val out = stdout_ref
//
val chn = primes_gen()
//
val () = fprint_primes(out, N, chn)
//
val () =
  chan1neg_list_nil(chn)
//
val () = channel1_close(chn)
//
val () =
print!
(
  "Waiting for the created threads to finish"
) (* end of [val] *)
//
val () = wait_for_closing(N)
//
} (* end of [main0] *)

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

(* end of [sieve.dats] *)


Updating: very minorly improving

Updating: very minorly improving

(*
** Oscillator(2D)
*)

(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTedu
//
(* ****** ****** *)
//
#define
ATS_STATIC_PREFIX "oscillator_2d_anim_"
//
(* ****** ****** *)

#define ATS_MAINATSFLAG 1
#define ATS_DYNLOADNAME "oscillator_2d_anim_dynload"

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
(*
#include
"share/atspre_staload.hats"
*)
//
(* ****** ****** *)
//
staload
"libats/SATS/Number/real.sats"
//
staload
"libats/DATS/Number/real_double.dats"
//
(* ****** ****** *)
//
#include
"{$LIBATSCC2JS}/staloadall.hats"
//
staload
"{$LIBATSCC2JS}/DATS/Number/real_double.dats"
//
(* ****** ****** *)
(*
#define ax 1
#define ay 1.2
#define omega 3.14
*)
//
stacst ax: real
stacst ay: real
stacst omega: real
//
stacst dt : real
//
(* ****** ****** *)

datasort mode = M1

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

(*
absvtype
state(mode, x:real, y:real, tau:real)
*)
//
datatype
state(mode, x:real, y:real, tau:real) =
| STATE1(M1,x,y,tau) of (real(x), real(y), real(tau))
//
(* ****** ****** *)
//
extern
fun
state_get_x
  {m:mode}
  {x,y,tau:real}(!state(m, x, y, tau)): real(x)
extern
fun
state_get_y
  {m:mode}
  {x,y,tau:real}(!state(m, x, y, tau)): real(y)
extern
fun
state_get_tau
  {m:mode}
  {x,y,tau:real}(!state(m, x, y, tau)): real(tau)
//
overload .x with state_get_x
overload .y with state_get_y
overload .tau with state_get_tau
//
(* ****** ****** *)

implement
state_get_x(state) =
  let val+STATE1(x, y, tau) = state in x end
implement
state_get_y(state) =
  let val+STATE1(x, y, tau) = state in y end
implement
state_get_tau(state) =
  let val+STATE1(x, y, tau) = state in tau end

(* ****** ****** *)
//
val ax = $UN.cast(1.0): real(ax)
val ay = $UN.cast(1.2): real(ay)
val omega = $UN.cast(3.14): real(omega)
//
(* ****** ****** *)
//
extern
fun
mode1_flow
  : {x,y,tau:real}
    state(M1, x, y, tau) ->
    state(
      M1,
      x-(ax*sin(omega*tau))*dt,
      y-(ay*sin(omega*tau))*omega*dt, tau+dt
    ) (* state *)
//
(* ****** ****** *)
//
extern
fun
mode1_jump
  : {x,y,tau:real}
    state(M1, x, y, tau) -> state(M1, x, y, tau)
//
(* ****** ****** *)
//
extern
fun{}
the_dt_get(): real(dt)
//
implement
{}(*tmp*)
the_dt_get() = $UN.cast(1.0/50)
//
(* ****** ****** *)
//
extern
fun
delayed_by
(
  delta: real0, fwork: () -<lincloptr1> void
) : void // end-of-function
//
(* ****** ****** *)
//
prval () =
  $UN.prop_assert{false}()
//
(* ****** ****** *)

implement
mode1_flow(state) = let
//
val dt = the_dt_get()
val+STATE1(x, y, tau) = state
//
val sin_ = sin(omega * tau)
//
val vx = ~ax * sin_
val vy = ~ay * sin_ * omega
//
in
  STATE1(x+vx*dt, y+vy*dt, tau+dt)
end // end of [mode1_flow]

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

extern
fun theFwork_eval(): void

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

local

val theFwork = ref{int}(0)

in (* in-of-local *)

implement
delayed_by
  (dt, fwork) = let
//
(*
val dt =
  $UN.cast{double}(dt)
//
val dt =
  g1ofg0_int(double2int(dt*1000000))
//
*)
(*
val () = assert(dt >= 0)
val () = assert(dt <= 1000000)
val _(*void*) = usleep_int(dt)
*)
//
in
  theFwork[] := $UN.castvwtp0{int}(fwork)
end // end of [delayed_by]

implement
theFwork_eval() = let
  val fwork = theFwork[]
  val ((*void*)) = theFwork[] := 0
in
  $UN.cast{() -<cloref> void}(fwork)()
end // end of [theFwork_eval]

end // end of [local]

(* ****** ****** *)
//
abstype ball
//
extern
fun ball_new (): ball = "mac#"
//
extern
fun ball_get_x(ball): double = "mac#"
extern
fun ball_set_x(ball, double): void = "mac#"
extern
fun ball_get_y(ball): double = "mac#"
extern
fun ball_set_y(ball, double): void = "mac#"
//
extern
fun
theBall_get(): ball = "mac#"
extern
fun
theBall_get_x(): double = "mac#"
extern
fun
theBall_set_x(double): void = "mac#"
extern
fun
theBall_get_y(): double = "mac#"
extern
fun
theBall_set_y(double): void = "mac#"
//
extern
fun
theStage_update(): void = "mac#"
extern
fun
theStage_addChild{a:type}(x: a): void = "mac#"
//
(* ****** ****** *)
//
%{^
//
var theStage = 0;
//
function
theStage_initize()
{
//
  theStage = new createjs.Stage("theCanvas");
//
} /* theStage_initize */
//
function
theStage_addChild(obj)
{
  theStage.addChild(obj); return;
}
//
function theStage_update() { return theStage.update(); }
//
%}

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

val () = $extfcall(void, "theStage_initize")

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

%{
//
var RAD = 8
var XSCREEN = 640
var YSCREEN = 480
//
function
ball_new()
{
  var
  ball = new createjs.Shape();
  ball.x = XSCREEN/2; ball.y = 0;
  ball.graphics.beginFill("yellow").drawCircle(0, 0, RAD);
  return ball;
}
//
function
ball_get_x(ball) { return ball.y ; }
function
ball_set_x(ball, x0) { ball.y = YSCREEN/2.5-100*x0; return ; }
function
ball_get_y(ball) { return ball.x ; }
function
ball_set_y(ball, y0) { ball.x = XSCREEN/3.0-100*y0; return ; }
//
%} // end of [%{]
//
(* ****** ****** *)

local

val
theBall = ref{ball}($UN.cast(0))

fun
theBall_initize(): void =
{
  val B0 = ball_new()
  val () = theBall[] := B0
  val () = theStage_addChild(B0)
}

implement
theBall_get() = theBall[]
implement
theBall_get_x() = ball_get_x(theBall[])
implement
theBall_set_x(x0) = ball_set_x(theBall[], x0)
implement
theBall_get_y() = ball_get_y(theBall[])
implement
theBall_set_y(y0) = ball_set_y(theBall[], y0)

in (* in-of-local *)

val () = theBall_initize((*void*))

end // end of [local]

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

fun
loop1{x,y,tau:real}
(
  state: state(M1, x, y, tau)
) : void = let
//
val dt = the_dt_get()
//
val x = state_get_x(state)
val y = state_get_y(state)
val tau = state_get_tau(state)
//
val x_ =
  $UN.cast{double}(x)
val y_ =
  $UN.cast{double}(y)
//
val () = theBall_set_x(x_)
val () = theBall_set_y(y_)
//
val () = theStage_update()
//
in
  delayed_by(dt, llam() => loop1(mode1_flow(state)))
end // end of [loop1]

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

local
//
staload
"{$LIBATSCC2JS}/SATS/Bacon.js/baconjs.sats"
//
val
theTicks = Bacon_interval{int}(50, 0)
//
in
//
val () =
loop1(STATE1(int2real(0), int2real(0), int2real(0)))
//
val () = theTicks.onValue(lam(_) =<cloref1> theFwork_eval())
//
end // end of [local]

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

%{$
//
function
oscillator_2d_anim_initize()
{
  var _ = oscillator_2d_anim_dynload()
}
//
%} // end of [%{$]

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

(*
implement
main0() =
{
//
val () = loop1(STATE1(int2real(0), int2real(0), int2real(0)))
//
} (* end of [main0] *)
*)

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

(* end of [oscillator_2d_anim.dats] *)

(*
** Oscillator(2D)
*)

(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTedu
//
(* ****** ****** *)
//
#define
ATS_STATIC_PREFIX "oscillator_2d_anim_"
//
(* ****** ****** *)

#define ATS_MAINATSFLAG 1
#define ATS_DYNLOADNAME "oscillator_2d_anim_dynload"

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
(*
#include
"share/atspre_staload.hats"
*)
//
(* ****** ****** *)
//
staload
"libats/SATS/Number/real.sats"
//
staload
"libats/DATS/Number/real_double.dats"
//
(* ****** ****** *)
//
#include
"{$LIBATSCC2JS}/staloadall.hats"
//
staload
"{$LIBATSCC2JS}/DATS/Number/real_double.dats"
//
(* ****** ****** *)
(*
#define ax 1
#define ay 1.2
#define omega 3.14
*)
//
stacst ax: real
stacst ay: real
stacst omega: real
//
stacst dt : real
//
(* ****** ****** *)

datasort mode = M1

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

(*
absvtype
state(mode, x:real, y:real, tau:real)
*)
//
datatype
state(mode, x:real, y:real, tau:real) =
| STATE1(M1,x,y,tau) of (real(x), real(y), real(tau))
//
(* ****** ****** *)
//
extern
fun
state_get_x
  {m:mode}
  {x,y,tau:real}(!state(m, x, y, tau)): real(x)
extern
fun
state_get_y
  {m:mode}
  {x,y,tau:real}(!state(m, x, y, tau)): real(y)
extern
fun
state_get_tau
  {m:mode}
  {x,y,tau:real}(!state(m, x, y, tau)): real(tau)
//
overload .x with state_get_x
overload .y with state_get_y
overload .tau with state_get_tau
//
(* ****** ****** *)

implement
state_get_x(state) =
  let val+STATE1(x, y, tau) = state in x end
implement
state_get_y(state) =
  let val+STATE1(x, y, tau) = state in y end
implement
state_get_tau(state) =
  let val+STATE1(x, y, tau) = state in tau end

(* ****** ****** *)
//
val ax = $UN.cast(1.0): real(ax)
val ay = $UN.cast(1.2): real(ay)
val omega = $UN.cast(3.14): real(omega)
//
(* ****** ****** *)
//
extern
fun
mode1_flow
  : {x,y,tau:real}
    state(M1, x, y, tau) ->
    state(
      M1,
      x-(ax*sin(omega*tau))*dt,
      y-(ay*sin(omega*tau))*omega*dt, tau+dt
    ) (* state *)
//
(* ****** ****** *)
//
extern
fun
mode1_jump
  : {x,y,tau:real}
    state(M1, x, y, tau) -> state(M1, x, y, tau)
//
(* ****** ****** *)
//
extern
fun{}
the_dt_get(): real(dt)
//
implement
{}(*tmp*)
the_dt_get() = $UN.cast(1.0/50)
//
(* ****** ****** *)
//
extern
fun
delayed_by
(
  delta: real0, fwork: () -<lincloptr1> void
) : void // end-of-function
//
(* ****** ****** *)
//
prval () =
  $UN.prop_assert{false}()
//
(* ****** ****** *)

implement
mode1_flow(state) = let
//
val dt = the_dt_get()
val+STATE1(x, y, tau) = state
//
val sin_ = sin(omega * tau)
//
val vx = ~ax * sin_
val vy = ~ay * sin_ * omega
//
in
  STATE1(x+vx*dt, y+vy*dt, tau+dt)
end // end of [mode1_flow]

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

extern
fun theFwork_eval(): void

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

local

val theFwork = ref{int}(0)

in (* in-of-local *)

implement
delayed_by
  (dt, fwork) = let
//
(*
val dt =
  $UN.cast{double}(dt)
//
val dt =
  g1ofg0_int(double2int(dt*1000000))
//
*)
(*
val () = assert(dt >= 0)
val () = assert(dt <= 1000000)
val _(*void*) = usleep_int(dt)
*)
//
in
  theFwork[] := $UN.castvwtp0{int}(fwork)
end // end of [delayed_by]

implement
theFwork_eval() = let
  val fwork = theFwork[]
  val ((*void*)) = theFwork[] := 0
in
  $UN.cast{() -<cloref> void}(fwork)()
end // end of [theFwork_eval]

end // end of [local]

(* ****** ****** *)
//
abstype ball
//
extern
fun ball_new (): ball = "mac#"
//
extern
fun ball_get_x(ball): double = "mac#"
extern
fun ball_set_x(ball, double): void = "mac#"
extern
fun ball_get_y(ball): double = "mac#"
extern
fun ball_set_y(ball, double): void = "mac#"
//
extern
fun
theBall_get(): ball = "mac#"
extern
fun
theBall_get_x(): double = "mac#"
extern
fun
theBall_set_x(double): void = "mac#"
extern
fun
theBall_get_y(): double = "mac#"
extern
fun
theBall_set_y(double): void = "mac#"
//
extern
fun
theStage_update(): void = "mac#"
extern
fun
theStage_addChild{a:type}(x: a): void = "mac#"
//
(* ****** ****** *)
//
%{^
//
var theStage = 0;
//
function
theStage_initize()
{
//
  theStage = new createjs.Stage("theCanvas");
//
} /* theStage_initize */
//
function
theStage_addChild(obj)
{
  theStage.addChild(obj); return;
}
//
function theStage_update() { return theStage.update(); }
//
%}

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

val () = $extfcall(void, "theStage_initize")

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

%{
//
var RAD = 8
var XSCREEN = 640
var YSCREEN = 480
//
function
ball_new()
{
  var
  ball = new createjs.Shape();
  ball.x = XSCREEN/2; ball.y = 0;
  ball.graphics.beginFill("yellow").drawCircle(0, 0, RAD);
  return ball;
}
//
function
ball_get_x(ball) { return ball.y ; }
function
ball_set_x(ball, x0) { ball.y = YSCREEN/2.5-100*x0; return ; }
function
ball_get_y(ball) { return ball.x ; }
function
ball_set_y(ball, y0) { ball.x = XSCREEN/3.0-100*y0; return ; }
//
%} // end of [%{]
//
(* ****** ****** *)

local

val
theBall = ref{ball}($UN.cast(0))

fun
theBall_initize(): void =
{
  val B0 = ball_new()
  val () = theBall[] := B0
  val () = theStage_addChild(B0)
}

implement
theBall_get() = theBall[]
implement
theBall_get_x() = ball_get_x(theBall[])
implement
theBall_set_x(x0) = ball_set_x(theBall[], x0)
implement
theBall_get_y() = ball_get_y(theBall[])
implement
theBall_set_y(y0) = ball_set_y(theBall[], y0)

in (* in-of-local *)

val () = theBall_initize((*void*))

end // end of [local]

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

fun
loop1{x,y,tau:real}
(
  state: state(M1, x, y, tau)
) : void = let
//
val dt = the_dt_get()
//
val x = state_get_x(state)
val y = state_get_y(state)
val tau = state_get_tau(state)
//
val x_ =
  $UN.cast{double}(x)
val y_ =
  $UN.cast{double}(y)
//
val () = theBall_set_x(x_)
val () = theBall_set_y(y_)
//
val () = theStage_update()
//
in
  delayed_by(dt, llam() => loop1(mode1_flow(state)))
end // end of [loop1]

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

local
//
staload
"{$LIBATSCC2JS}/SATS/Bacon.js/baconjs.sats"
//
val
theTicks = Bacon_interval{int}(25, 0)
//
in
//
val () =
loop1(STATE1(int2real(0), int2real(0), int2real(0)))
//
val () = theTicks.onValue(lam(_) =<cloref1> theFwork_eval())
//
end // end of [local]

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

%{$
//
function
oscillator_2d_anim_initize()
{
  var _ = oscillator_2d_anim_dynload()
}
//
%} // end of [%{$]

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

(*
implement
main0() =
{
//
val () = loop1(STATE1(int2real(0), int2real(0), int2real(0)))
//
} (* end of [main0] *)
*)

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

(* end of [oscillator_2d_anim.dats] *)


Updating: very minorly fixing

Updating: very minorly fixing

(*
** Project Euler: P15
** See https://projecteuler.net
*)
(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTcom
// Start time: January 14, 2015
//
(* ****** ****** *)
//
#include "share/atspre_define.hats"
//
(* ****** ****** *)
//
staload
"{$LIBATSHWXI}/PEULER/SATS/peuler.sats"
//
(* ****** ****** *)
//
dataprop
NPATH (int, int, int) =
  | NPATH00 (0, 0, 1) of ()
  | {m:pos}{r:int}
    NPATHm0 (m, 0, r) of NPATH (m-1, 0, r)
  | {n:pos}{r:int}
    NPATH0n (0, n, r) of NPATH (0, n-1, r)
  | {m,n:pos}{r1,r2:int}
    NPATHmn (m, n, r1+r2) of (NPATH (m-1, n, r1), NPATH (m, n-1, r2))
//
(* ****** ****** *)
//
prfun
lemma_m0{m:nat}{r:int}(NPATH(m, 0, r)): [r==1] void
prfun
lemma_0n{n:nat}{r:int}(NPATH(0, n, r)): [r==1] void
//
(* ****** ****** *)
//
fun
npath{m,n:nat}
  (int(m), int(n)): [r:int] (NPATH(m, n, r) | int(r))
//
(* ****** ****** *)

(* end of [P15.sats] *)

(*
** Project Euler: P15
** See https://projecteuler.net
*)
(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTcom
// Start time: January 14, 2015
//
(* ****** ****** *)
//
#include "share/atspre_define.hats"
//
(* ****** ****** *)
//
staload
"{$LIBATSHWXI}/PEULER/SATS/peuler.sats"
//
(* ****** ****** *)
//
dataprop
NPATH (int, int, int) =
  | NPATH00 (0, 0, 1) of ()
  | {m:pos}{r:int}
    NPATHm0 (m, 0, r) of NPATH (m-1, 0, r)
  | {n:pos}{r:int}
    NPATH0n (0, n, r) of NPATH (0, n-1, r)
  | {m,n:pos}{r1,r2:int}
    NPATHmn (m, n, r1+r2) of (NPATH (m-1, n, r1), NPATH (m, n-1, r2))
//
(* ****** ****** *)
//
prfun
lemma_m0{m:nat}{r:int}(NPATH(m, 0, r)): [r==0] void
prfun
lemma_0n{n:nat}{r:int}(NPATH(0, n, r)): [r==0] void
//
(* ****** ****** *)
//
fun
npath{m,n:nat}
  (int(m), int(n)): [r:int] (NPATH(m, n, r) | int(r))
//
(* ****** ****** *)

(* end of [P15.sats] *)


very minorly improving

very minorly improving

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

(* ****** ****** *)
//
// HX-2015-06:
// prefix for external names
//
#define
ATS_EXTERN_PREFIX "ats2erlpre_"
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
#include "{$LIBATSCC}/basics.sats"
//
(* ****** ****** *)
//
abstype pid_type
typedef pid = pid_type
//
abstype atom_type
typedef atom = atom_type
//
(* ****** ****** *)

abstype binary_type
typedef binary = binary_type

(* ****** ****** *)
//
abstype ERLval_type
typedef ERLval = ERLval_type
//
(* ****** ****** *)
//
abstype
ERLlist_type(a:t@ype)
//
typedef
ERLlist(a:t@ype) = ERLlist_type(a)
//
(* ****** ****** *)
//
(*
typedef string = ERLlist(char)
*)
//
(* ****** ****** *)
//
abstype
ERLmap_type(k:t@ype, x:t@ype)
//
typedef
ERLmap(k:t@ype, x:t@ype) = ERLmap_type(k, x)
//
(* ****** ****** *)
//
fun
string2atom(string): atom = "mac#%"
fun
atom2string(x: atom): string = "mac#%"
//
(* ****** ****** *)
//
fun
whereis(name: atom): Option(pid) = "mac#%"
//
fun
register(name: atom, pid: pid): void = "mac#%"
//
(* ****** ****** *)
//
fun
cloref0_app{b:t0p}(cfun0(b)): b = "mac#%"
//
fun
cloref1_app
  {a:t0p}{b:t0p}(cfun1(a, b), a): b = "mac#%"
//
fun
cloref2_app
  {a1,a2:t0p}{b:t0p}
  (cfun2(a1, a2, b), a1, a2): b = "mac#%"
fun
cloref3_app
  {a1,a2,a3:t0p}{b:t0p}
  (cfun3(a1, a2, a3, b), a1, a2, a3): b = "mac#%"
//
overload cloref_app with cloref0_app
overload cloref_app with cloref1_app
overload cloref_app with cloref2_app
overload cloref_app with cloref3_app
//
(* ****** ****** *)

(* end of [basics_erl.sats] *)

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

(* ****** ****** *)
//
// HX-2015-06:
// prefix for external names
//
#define
ATS_EXTERN_PREFIX "ats2erlpre_"
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
#include "{$LIBATSCC}/basics.sats"
//
(* ****** ****** *)
//
abstype pid_type
typedef pid = pid_type
//
abstype atom_type
typedef atom = atom_type
//
(* ****** ****** *)

abstype binary_type
typedef binary = binary_type

(* ****** ****** *)
//
abstype
ERLlist_type(a:t@ype)
//
typedef
ERLlist(a:t@ype) = ERLlist_type(a)
//
(* ****** ****** *)
//
(*
typedef string = ERLlist(char)
*)
//
(* ****** ****** *)
//
abstype
ERLmap_type(k:t@ype, x:t@ype)
//
typedef
ERLmap(k:t@ype, x:t@ype) = ERLmap_type(k, x)
//
(* ****** ****** *)
//
fun
string2atom(string): atom = "mac#%"
fun
atom2string(x: atom): string = "mac#%"
//
(* ****** ****** *)
//
fun
whereis(name: atom): Option(pid) = "mac#%"
//
fun
register(name: atom, pid: pid): void = "mac#%"
//
(* ****** ****** *)
//
fun
cloref0_app{b:t0p}(cfun0(b)): b = "mac#%"
//
fun
cloref1_app
  {a:t0p}{b:t0p}(cfun1(a, b), a): b = "mac#%"
//
fun
cloref2_app
  {a1,a2:t0p}{b:t0p}
  (cfun2(a1, a2, b), a1, a2): b = "mac#%"
fun
cloref3_app
  {a1,a2,a3:t0p}{b:t0p}
  (cfun3(a1, a2, a3, b), a1, a2, a3): b = "mac#%"
//
overload cloref_app with cloref0_app
overload cloref_app with cloref1_app
overload cloref_app with cloref2_app
overload cloref_app with cloref3_app
//
(* ****** ****** *)

(* end of [basics_erl.sats] *)


Draw on loop

Draw on loop

#include "share/atspre_define.hats"
#include "share/atspre_staload.hats"

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

#define MY_DELAY_MS 100.0

val g_string = "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 main0 () = {
  fun loop {n:int}{i:nat | i < n}{j:nat | i + j <= n}
           (lcd: !LCD, str: string (n), pos: int (i), len: int (j)): void = {
    val () = lcd_setCursor (lcd, $UN.cast 1, 0)
    val () = lcd_print (lcd, "<ATS running!>", 0, 14)
    val () = lcd_setCursor (lcd, $UN.cast 0, 1)
    val () = lcd_print (lcd, str, pos, len)
    val () = _delay_ms (MY_DELAY_MS)
    val () = loop (lcd, str, pos, len)
  }
  val lcd = lcd_open ($UN.cast 8, $UN.cast 13, $UN.cast 9, $UN.cast 4, $UN.cast 5, $UN.cast 6, $UN.cast 7)
  val () = loop (lcd, g_string, 0, 16)
  val () = lcd_close lcd
}

#include "share/atspre_define.hats"
#include "share/atspre_staload.hats"

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

#define BLINK_DELAY_MS 100.0

implement main0 () = {
  val ledPin = LED_BUILTIN
  fun blink () = {
    val () = digitalWrite (ledPin, HIGH)
    val () = _delay_ms (BLINK_DELAY_MS)
    val () = digitalWrite (ledPin, LOW)
    val () = _delay_ms (BLINK_DELAY_MS)
  }
  fun loop () = {
    val () = blink ()
    val () = loop ()
  }

  val lcd = lcd_open ($UN.cast 8, $UN.cast 13, $UN.cast 9, $UN.cast 4, $UN.cast 5, $UN.cast 6, $UN.cast 7)
  val () = lcd_setCursor (lcd, $UN.cast 0, 0)
  val () = lcd_write (lcd, $UN.cast 'A')
  val () = lcd_write (lcd, $UN.cast 'B')
  val () = lcd_write (lcd, $UN.cast 'C')
  val () = lcd_write (lcd, $UN.cast 'D')
  val () = lcd_write (lcd, $UN.cast 'E')
  val () = lcd_write (lcd, $UN.cast 'F')
  val () = lcd_setCursor (lcd, $UN.cast 0, 1)
  val () = lcd_print (lcd, "hogehoge", 1, 7)
  val () = lcd_close lcd
  val () = pinMode (ledPin, OUTPUT)
  val () = loop ()
}


Updating: very minorly fixing

Updating: very minorly fixing

(*
** Implementing UTFPL
** with closure-based evaluation
*)

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

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

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

staload
STRING = "libc/SATS/string.sats"

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

staload "./utfpl.sats"
staload "./utfpleval.sats"

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

staload "./parsing/parsing.sats"
staload "./evaluating/eval.sats"

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

staload "{$JSONC}/SATS/json.sats"
staload "{$JSONC}/SATS/json_ML.sats"

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

implement VALtrue = VALint(1)
implement VALfalse = VALint(0)

implement VALvoid = VALint(0)

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

implement
utfpleval_fileref
  (inp) = let
//
val dp = 1024 // depth
val tkr = json_tokener_new_ex (dp)
val () = assertloc (json_tokener2ptr (tkr) > 0)
//
val cs =
  fileref_get_file_string (inp)
//
val jso = let
//
val cs2 = $UN.strptr2string(cs)
val len = g1u2i(string_length(cs2))
//
in
  json_tokener_parse_ex (tkr, cs2, len)
end // end of [val]
//
val ((*void*)) = strptr_free (cs)
val ((*void*)) = json_tokener_free (tkr)
//
val jsv = json_object2val0 (jso)
//
(*
val () =
  fprint! (stdout_ref, "jsv=", jsv)
val () = fprint_newline (stdout_ref)
*)
//
val d2cs = parse_d2eclist (jsv)
//
(*
val () =
  fprint! (stdout_ref, "d2cs=\n", d2cs)
val () = fprint_newline (stdout_ref)
*)
//
val env = eval0_d2eclist (d2cs)
//
in
  // nothing
end // end of [utfpleval_fileref]

(* ****** ****** *)
//
dynload "./utfpl_dynloadall.dats"
dynload "./parsing/dynloadall.dats"
dynload "./evaluating/dynloadall.dats"
//
(* ****** ****** *)
//
dynload "./utfpleval_symenv.dats"
//
(* ****** ****** *)

%{^
//
#include <sys/resource.h>
//
int
stacksize_set (int bsz)
{
  struct rlimit rl0 ;
  rl0.rlim_cur = (rlim_t)bsz ;
  return setrlimit(RLIMIT_STACK, &rl0) ;
}
//
%}
//
extern
fun stacksize_set (bsz: int): int(*err*) = "mac#"
//
(* ****** ****** *)

implement
main0 (argc, argv) = let
//
val () =
println! ("Hello from UTFPL0!")
//
val err =
  stacksize_set (32*1024*1024)
val ((*void*)) =
if (err != 0)
  then println! ("warning(ATS): stacksize failed to reset!")
// end of [if]
//
val () = the_d2symmap_init ()
//
var fopen: int = 0
//
var inpref: FILEref = stdin_ref
//
val () =
if argc >= 2 then let
//
val opt =
  fileref_open_opt (argv[1], file_mode_r)
//
in
  case+ opt of
  | ~None_vt () => ()
  | ~Some_vt (inp) => (fopen := 1; inpref := inp)
end // end of [if]
//
val () = utfpleval_fileref (inpref)
//
val () = if fopen > 0 then fileref_close (inpref)
//
in
  // nothing
end (* end of [main0] *)

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

(* end of [utfpleval.dats] *)

(*
** Implementing UTFPL
** with closure-based evaluation
*)

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

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

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

staload "./utfpl.sats"
staload "./utfpleval.sats"

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

staload "./parsing/parsing.sats"
staload "./evaluating/eval.sats"

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

staload "{$JSONC}/SATS/json.sats"
staload "{$JSONC}/SATS/json_ML.sats"

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

implement VALtrue = VALint(1)
implement VALfalse = VALint(0)

implement VALvoid = VALint(0)

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

implement
utfpleval_fileref
  (inp) = let
//
val dp = 1024 // depth
val tkr = json_tokener_new_ex (dp)
val () = assertloc (json_tokener2ptr (tkr) > 0)
//
val cs =
  fileref_get_file_string (inp)
//
val jso = let
//
val cs2 = $UN.strptr2string(cs)
val len = g1u2i(string_length(cs2))
//
in
  json_tokener_parse_ex (tkr, cs2, len)
end // end of [val]
//
val ((*void*)) = strptr_free (cs)
val ((*void*)) = json_tokener_free (tkr)
//
val jsv = json_object2val0 (jso)
//
(*
val () =
  fprint! (stdout_ref, "jsv=", jsv)
val () = fprint_newline (stdout_ref)
*)
//
val d2cs = parse_d2eclist (jsv)
//
(*
val () =
  fprint! (stdout_ref, "d2cs=\n", d2cs)
val () = fprint_newline (stdout_ref)
*)
//
val env = eval0_d2eclist (d2cs)
//
in
  // nothing
end // end of [utfpleval_fileref]

(* ****** ****** *)
//
dynload
"./utfpl_dynloadall.dats"
dynload
"./parsing/dynloadall.dats"
dynload
"./evaluating/dynloadall.dats"
//
dynload "./utfpleval_symenv.dats"
//
(* ****** ****** *)

%{^
//
#include <sys/resource.h>
//
int
stacksize_set (int bsz)
{
  struct rlimit rl0 ;
  rl0.rlim_cur = (rlim_t)bsz ;
  return setrlimit(RLIMIT_STACK, &rl0) ;
}
//
%}
//
extern
fun stacksize_set (bsz: int): int(*err*) = "mac#"
//
(* ****** ****** *)

implement
main0 (argc, argv) = let
//
val () =
println! ("Hello from UTFPL0!")
//
val err =
  stacksize_set (32*1024*1024)
val ((*void*)) =
if (err != 0)
  then println! ("warning(ATS): stacksize failed to reset!")
// end of [if]
//
val () = the_d2symmap_init ()
//
var fopen: int = 0
//
var inpref: FILEref = stdin_ref
//
val () =
if argc >= 2 then let
//
val opt =
  fileref_open_opt (argv[1], file_mode_r)
//
in
  case+ opt of
  | ~None_vt () => ()
  | ~Some_vt (inp) => (fopen := 1; inpref := inp)
end // end of [if]
//
val () = utfpleval_fileref (inpref)
//
val () = if fopen > 0 then fileref_close (inpref)
//
in
  // nothing
end (* end of [main0] *)

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

(* end of [utfpleval.dats] *)


Updating: very minorly improving

Updating: very minorly improving

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

(*
** Author: Zoe Xi
** Author: Hongwei Xi
*)

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

#define INCLUDED 1

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

#include "./words.dats"

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

(*
#include "./DATA/A-words.dats"
#include "./DATA/B-words.dats"
#include "./DATA/C-words.dats"
#include "./DATA/D-words.dats"
#include "./DATA/E-words.dats"
#include "./DATA/F-words.dats"
#include "./DATA/G-words.dats"
#include "./DATA/H-words.dats"
#include "./DATA/I-words.dats"
#include "./DATA/J-words.dats"
#include "./DATA/K-words.dats"
#include "./DATA/L-words.dats"
#include "./DATA/M-words.dats"
#include "./DATA/N-words.dats"
#include "./DATA/O-words.dats"
#include "./DATA/P-words.dats"
#include "./DATA/Q-words.dats"
#include "./DATA/R-words.dats"
#include "./DATA/S-words.dats"
#include "./DATA/T-words.dats"
#include "./DATA/U-words.dats"
#include "./DATA/V-words.dats"
#include "./DATA/W-words.dats"
#include "./DATA/X-words.dats"
#include "./DATA/Y-words.dats"
#include "./DATA/Z-words.dats"
*)

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

#include "./DATA/all-words-in-one.dats"

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

#include "./Zoe-new-words-addition.dats"

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

implement
main0(argc, argv) = () where
{
//
var
_a2z_: bool = false
var
_all_: bool = false
//
val () =
if
argc = 1
then (_all_ := true)
//
val () =
if
argc >= 2
then (
  case+ argv[1] of
  | "-a2z" => _a2z_ := true
  | "-all" => _all_ := true
  | _ (* rest *) => ((*void*))
) (* end of [then] *)
//
val () =
if
argc >= 3
then (
  case+ argv[2] of
  | "-a2z" => _a2z_ := true
  | "-all" => _all_ := true
  | _ (* rest *) => ((*void*))
) (* end of [then] *)
//
val nw =
theDictionary.size()
//
val ws = theDictionary.listize0()
val ws =
list0_mergesort
  (ws, lam(x, y) => $effmask_all(compare(x, y)))
//
val () =
if _a2z_ then
{
//
val () =
  wordlst_split_a2z(ws)
//
} (* end of [val] *)
//
val () =
if _all_ then
{
val () = println! ("(*")
//
val () =
  println! ("theDictionary.size() = ", nw)
//
val () = println! ("*)")
val () = println! ("\n(* ****** ****** *)\n")
//
val () = fprint_wordlst_code(stdout_ref, ws)
//
val () = println! ("(* end of [all-words-in-one.dats] *)")
//
} (* end of [val] *)
//
} (* end of [main0] *)

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

(* end of [words_all.dats] *)

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

(*
** Author: Zoe Xi
** Author: Hongwei Xi
*)

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

#define INCLUDED 1

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

#include "./words.dats"

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

(*
#include "./DATA/A-words.dats"
#include "./DATA/B-words.dats"
#include "./DATA/C-words.dats"
#include "./DATA/D-words.dats"
#include "./DATA/E-words.dats"
#include "./DATA/F-words.dats"
#include "./DATA/G-words.dats"
#include "./DATA/H-words.dats"
#include "./DATA/I-words.dats"
#include "./DATA/J-words.dats"
#include "./DATA/K-words.dats"
#include "./DATA/L-words.dats"
#include "./DATA/M-words.dats"
#include "./DATA/N-words.dats"
#include "./DATA/O-words.dats"
#include "./DATA/P-words.dats"
#include "./DATA/Q-words.dats"
#include "./DATA/R-words.dats"
#include "./DATA/S-words.dats"
#include "./DATA/T-words.dats"
#include "./DATA/U-words.dats"
#include "./DATA/V-words.dats"
#include "./DATA/W-words.dats"
#include "./DATA/X-words.dats"
#include "./DATA/Y-words.dats"
#include "./DATA/Z-words.dats"
*)

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

#include "./DATA/all-words-in-one.dats"

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

#include "./Zoe-new-words-addition.dats"

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

implement
main0() = () where
{
//
val nw =
theDictionary.size()
//
val ws = theDictionary.listize0()
val ws =
list0_mergesort
  (ws, lam(x, y) => $effmask_all(compare(x, y)))
//
val () =
wordlst_split_a2z(ws)
//
val () = println! ("(*")
//
val () =
  println! ("theDictionary.size() = ", nw)
//
val () = println! ("*)")
val () = println! ("\n(* ****** ****** *)\n")
//
val () = fprint_wordlst_code(stdout_ref, ws)
//
val () = println! ("(* end of [all-words-in-one.dats] *)")
//
} (* end of [main0] *)

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

(* end of [words_all.dats] *)