Revert "Delete Bit.hats, because it is not used."

This reverts commit 23ff3b5381f1065f0d5d6645603913c7e35fac17.

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

prfn {n:int} le_plus_1 ():[n <= n + 1] void = ()
prfn {n:int} le_refl   ():[n <= n]     void = ()
prfn {n:int} plus_0    ():[n == n + 0] void = ()

prfun le_plus_nat {n,m:int | n <= m}{p:nat} .<p>. ():[n <= m+p] void =
  sif 0 < p then let
      prval () = le_plus_nat {n,m}{p-1} ()
    in le_plus_1<n> () end
  else let
      prval () = plus_0<m> ()
    in (* nothing *) end

dataprop POW2 (int,int) =
 | POW2_0 (0,1) of ()
 | {n,v:int} POW2_N (n+1,v+v) of POW2 (n,v)

prfun pow2_total {n:nat} .<n>. ():[npow:int] POW2 (n,npow) =
  sif 0 < n then POW2_N (pow2_total {n-1} ())
            else POW2_0 ()

extern praxi pow2_domain_nat {n,npow:int} (POW2 (n,npow)):[0 <= n] void

prfun pow2_range_lte_1 {n:nat}{npow:int} .<n>. (pow:POW2 (n,npow)):[1 <= npow] void
 = case+ pow of
   | POW2_0 ()        => () // 1 <= 1
   | POW2_N (pow_ind) => let
       prval () = pow2_domain_nat (pow_ind)
       prval () = pow2_range_lte_1 (pow_ind)
     in  end // 1 <= npow_ind -> 1 <= npow_ind+npow_ind

prfn pow2_lte {n,npow:int} (pow2:POW2 (n,npow)):[0 <= n][1 <= npow] void
 = let
     prval () = pow2_domain_nat (pow2)
     prval () = pow2_range_lte_1 (pow2)
   in end

prfun pow2_injective {n,npow1,npow2:nat} .<n>. (pow1:POW2 (n,npow1), pow2:POW2 (n,npow2)):[npow1==npow2] void
 = sif 0 < n then let
       prval POW2_N (pow1') = pow1
       prval POW2_N (pow2') = pow2
     in pow2_injective (pow1',pow2') end
   else case+ (pow1,pow2) of
        | (POW2_0 (), POW2_0 ()) => () // 0 == 0
        | (POW2_N (pow_ind), _) =/=> let prval () = pow2_lte (pow_ind) in end // 0 == n && 0 <= n-1
        | (_, POW2_N (pow_ind)) =/=> let prval () = pow2_lte (pow_ind) in end // 0 == n && 0 <= n-1

prfn npow_lte_int31 {npow:nat}
      (pow2:POW2 (31,npow)): [npow <= 2147483648] void
 = let
    prfn npow_double {n,npow,nmax:nat | npow <= nmax/2}
      (pow2:POW2 (n,npow)):[npow+npow <= nmax] POW2 (n+1,npow+npow)
     = POW2_N pow2
    prval pow2' = npow_double {30,1073741824,2147483648}(npow_double {29,536870912,1073741824}(
                  npow_double {28,268435456,536870912}(npow_double {27,134217728,268435456}(
                  npow_double {26,67108864,134217728}(npow_double {25,33554432,67108864}(
                  npow_double {24,16777216,33554432}(npow_double {23,8388608,16777216}(
                  npow_double {22,4194304,8388608}(npow_double {21,2097152,4194304}(
                  npow_double {20,1048576,2097152}(npow_double {19,524288,1048576}(
                  npow_double {18,262144,524288}(npow_double {17,131072,262144}(
                  npow_double {16,65536,131072}(npow_double {15,32768,65536}(
                  npow_double {14,16384,32768}(npow_double {13,8192,16384}(
                  npow_double {12,4096,8192}(npow_double {11,2048,4096}(
                  npow_double {10,1024,2048}(npow_double {9,512,1024}(
                  npow_double {8,256,512}(npow_double {7,128,256}(
                  npow_double {6,64,128}(npow_double {5,32,64}(
                  npow_double {4,16,32}(npow_double {3,8,16}(
                  npow_double {2,4,8}(npow_double {1,2,4}(
                  npow_double {0,1,2}(POW2_0 (
                  ))))))))))))))))))))))))))))))))
    prval () = pow2_injective(pow2,pow2')
 in  end

prfun npow_monotonically_increasing {n,m,npow,mpow:nat | n < m}
      .<m>. (pow2_n:POW2 (n,npow),pow2_m:POW2 (m,mpow)):[npow < mpow] void
 = case+ pow2_m of
   | POW2_0 ()           =/=> () // (n < m) && (0 = m)
   | POW2_N (pow2_m_ind) =>   let
       prval () = pow2_lte (pow2_m_ind)
     in case+ pow2_n of
        | POW2_0 ()           => () // (0 = n) && (0 <= m-1)
        | POW2_N (pow2_n_ind) => let
            prval () = pow2_lte (pow2_n_ind)
          in npow_monotonically_increasing (pow2_n_ind, pow2_m_ind) end
     end

prfun npow_intmax {n,npow,m:nat | n < INTBITS; m < npow}
      .<INTBITS - n>. (pow2:POW2 (n,npow)): [m <= INTMAX] void
 = sif (31 == n) then npow_lte_int31 (pow2)
   else let
        prval () = pow2_lte (POW2_N (pow2))
        prval () = npow_intmax{n+1,npow+npow,m+m} (POW2_N (pow2))
   in npow_monotonically_increasing (pow2,POW2_N (pow2)) end

prfn beqint_is_nat {n,v:int}{bs:bits}
  (beqint_fst:BITSEQINT (n,bs,v)):[0 <= v] void =
let
  prfun aux {n,v:int}{bs:bits} .<bs>. (beqint:BITSEQINT (n,bs,v)):[0 <= v] void =
    case+ beqint of
    | BEQNIL   ()       => le_refl ()   // 0 <= 0
    | BEQCONS (beqind,B0EQ0 ()) => aux (beqind) // (0 <= n) -> (0 <= n+0)
    | BEQCONS (beqind,B1EQ1 ()) => aux (beqind) // (0 <= n) -> (0 <= n+1)
in aux (beqint_fst) end

dataprop NAT_EVEN (int) =
 | NEVENbas (0) of ()
 | {n:nat} NEVENind (n+2) of NAT_EVEN (n)

dataprop NAT_ODD (int) =
 | NODDbas (1) of ()
 | {n:nat} NODDind (n+2) of NAT_ODD (n)

prfn {n:int} neven_nat (ev:NAT_EVEN (n)):[0 <= n] void
 = case+ ev of
   | NEVENbas ()       => le_refl ()
   | NEVENind {n'} (_) => le_plus_nat {0,n'}{2} ()

prfn {n:int} nodd_gte_1 (odd:NAT_ODD (n)):[1 <= n] void
 = sif 1 <= n then ()
       else case+ odd of
       | NODDbas ()       =/=> () // 1 < 1
       | NODDind {n'} (_) =/=> () // 0 <= n' && n'+2 < 1

prfun nodd_prev_is_even {n:nat} .<n>. (odd:NAT_ODD (n)):NAT_EVEN (n-1)
 = case+ odd of
   | NODDbas ()       => NEVENbas ()
   | NODDind (oddind) => let
       prval () = nodd_gte_1 (oddind)
     in NEVENind (nodd_prev_is_even (oddind)) end

datasort oddity = EVEN | ODD

dataprop NAT_ODDITY (int,oddity) =
 | {n:int} NATeven (n,EVEN) of NAT_EVEN (n)
 | {n:int} NATodd  (n,ODD)  of NAT_ODD  (n)

prfun natoddity_total {n:nat} .<n>. ():[o:oddity] NAT_ODDITY (n,o)
 = sif      n == 0 then NATeven (NEVENbas ())
   else sif n == 1 then NATodd  (NODDbas  ())
   else     case+ natoddity_total {n-2} () of
            | NATeven (ev)  => NATeven (NEVENind (ev))
            | NATodd  (odd) => let prval () = nodd_gte_1 (odd)
                               in NATodd  (NODDind  (odd)) end

prfun nat_half {n:nat} .<n>. (ev:NAT_EVEN (n)):[h:nat | h+h == n] int h
 = case+ ev of
   | NEVENbas ()   => 0 // 0+0 == 0
   | NEVENind {n'} (ev) => let prval () = neven_nat<n'> (ev)
                           in nat_half {n'} (ev) + 1 (* h+h == n' -> h+1 + h+1 == n'+2 *) end

prfn double_v_lt_2pow_succ__v_lt_2pow {v,n,npow_succ,npow:nat | v+v < npow_succ}
                                      (pow2:POW2(n,npow),pow2succ:POW2 (n+1,npow_succ)):[v < npow] void
 = let
     prval () = pow2_injective (POW2_N (pow2), pow2succ)// npow_succ == npow+npow
   in end // v+v < npow+npow -> v < npow

prfun nat_eq_bits {n,npow,v:nat | v < npow}{v <= INTMAX} .<n>.
  (pow2:POW2 (n,npow)):[bs:bits] BITSEQINT (n,bs,v) =
  sif 0 < n then let
      prval POW2_N {n',npow'} (pow2ind) = pow2
      prval () = pow2_lte (pow2ind)
    in case+ natoddity_total {v} () of
       | NATeven (ev) => let
           prval [h:int](_) = nat_half {v} (ev)
           prval () = double_v_lt_2pow_succ__v_lt_2pow {h,n',npow,npow'} (pow2ind,pow2) // h < npow'
         in BEQCONS (nat_eq_bits {n',npow',h} (pow2ind),B0EQ0) end
       | NATodd  (odd) => let
           prval (ev) = nodd_prev_is_even (odd)
           prval () = nodd_gte_1 (odd)
           prval [h:int](_) = nat_half {v-1} (ev)
           prval () = double_v_lt_2pow_succ__v_lt_2pow {h,n',npow,npow'} (pow2ind,pow2) // h < npow'
         in BEQCONS (nat_eq_bits {n',npow',h} (pow2ind),B1EQ1) end
    end
  else let
      prval () = pow2_injective (pow2, POW2_0 ())
    in BEQNIL () end

error: pathspec 'Bit.hats' did not match any file(s) known to git


Updating: very minorly improving

Updating: very minorly improving

(* ****** ****** *)
//
// HX-2016-05:
// A running example
// from ATS2 to Scheme
//
(* ****** ****** *)
//
#define ATS_DYNLOADFLAG 0
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
(* ****** ****** *)
//
#include
"{$LIBATSCC2SCM}/staloadall.hats"
//
(* ****** ****** *)
//
extern
fun
listlen{a:t0p}
  : List0 (a) -> int = "mac#listlen"
//
implement
listlen{a}
  (xs) = let
//
prval
(
// argless
) = lemma_list_param (xs)
//
fun
loop{i,j:nat} .<i>.
(
  xs: list (a, i), res: int(j)
) : int(i+j) = let
in
//
case+ xs of
| list_nil () => res
| list_cons (_, xs) => loop (xs, res+1)
//
end // end of [loop]
//
in
  loop (xs, 0)
end // end of [listlen]

(* ****** ****** *)
//
extern
fun
fromto
  : (int, int) -> List0 (int) = "mac#fromto"
//
implement
fromto (m, n) =
if m < n
  then list_cons (m, fromto (m+1, n)) else list_nil ()
// end of [if]
//
(* ****** ****** *)

(* end of [listlen.dats] *)

error: pathspec 'projects/MEDIUM/CATS-atsccomp/CATS-atscc2scm/TEST/listlen.dats' did not match any file(s) known to git


mutually tail recursive calls in ATS

mutually tail recursive calls in ATS

// patscc -o mut_tailrec ch3_mutually_defined_tail_calls.dats && ./mut_tailrec

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

// Simple mutually recursive function could be defined as following:
// fun
//     iseven (n: int): bool = if n > 0 then isodd(n-1) else true
// and
//     isodd (n: int): bool = if n > 0 then iseven(n-1) else false

// If we want to compile into local jumps we might use special keyword `fnx`:
// We might do this easily, because here we have tail recursion.
fnx
    iseven (n: int): bool = if n > 0 then isodd(n-1) else true
and
    isodd (n: int): bool = if n > 0 then iseven(n-1) else false

// What the ATS compiler does in this case is to combine these two functions into a single one,
// so that each mutually recursive tail-call in their bodies can be turned into a self tail-call
// in the body of the combined function, which is then ready to be compiled into a local jump.

implement main0 () = let
  val v1 = 16
  val v2 = 17
in
  print("Is "); print(v1); print(" even? -"); print(iseven(v1)); print("\n");
  print("Is "); print(v2); print(" even? -"); print(iseven(v2)); print("\n")
end

error: pathspec 'ats/introduction_to_programming_in_ats/ch3_mutually_defined_tail_calls.dats' did not match any file(s) known to git


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)
//
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] *)

error: pathspec 'contrib/libats-/hwxi/teaching/mysession-g/TEST/sieve.dats' did not match any file(s) known to git


Add type to lwip (cont.)

Add type to lwip (cont.)

%{^
#include "lwip/inet.h"
#include "lwip/netif.h"
#include "lwip/dhcp.h"
#include "lwip/tcpip.h"
%}

(* lwip/err *)
abst@ype err_t = $extype"err_t"

(* lwip/ip_addr *)
abst@ype ip_addr_t = $extype"ip_addr_t"
typedef ip_addr_t_p = cPtr0(ip_addr_t)

(* lwip/pbuf *)
abst@ype struct_pbuf = $extype"struct pbuf"
typedef struct_pbuf_p = cPtr0(struct_pbuf)

(* lwip/netif *)
abst@ype struct_netif = $extype"struct netif"
typedef struct_netif_p = cPtr0(struct_netif)

typedef netif_init_fn = (struct_netif_p) -> err_t
typedef netif_input_fn = (struct_pbuf_p, struct_netif_p) -> err_t
typedef netif_status_callback_fn = (struct_netif_p) -> void

fun netif_is_up: (struct_netif_p) -> bool = "mac#"
fun netif_is_link_up: (struct_netif_p) -> bool = "mac#"

fun netif_add: (struct_netif_p, ip_addr_t_p, ip_addr_t_p, ip_addr_t_p, ptr, netif_init_fn, netif_input_fn) -> struct_netif_p = "mac#"
fun netif_set_default: (struct_netif_p) -> void = "mac#"
fun netif_set_link_callback: (struct_netif_p, netif_status_callback_fn) -> void = "mac#"
fun netif_set_status_callback: (struct_netif_p, netif_status_callback_fn) -> void = "mac#"
fun netif_set_up: (struct_netif_p) -> void = "mac#"
fun netif_set_down: (struct_netif_p) -> void = "mac#"

// xxx #define inet_aton(cp, addr)   ipaddr_aton(cp, (ip_addr_t*)addr)
// xxx #define inet_ntoa(addr)       ipaddr_ntoa((ip_addr_t*)&(addr))

(* lwip/tcpip *)
typedef tcpip_init_done_fn = (ptr) -> void

tcpip_init: (tcpip_init_done_fn, ptr) -> void = "mac#"

(* lwip/dhcp *)
fun dhcp_start: (struct_netif_p) -> err_t = "mac#"
fun dhcp_release: (struct_netif_p) -> err_t = "mac#"
fun dhcp_stop: (struct_netif_p) -> void = "mac#"

error: pathspec 'demos/halapi_ats/libmbedats/SATS/net_lwip_lwip.sats' did not match any file(s) known to git


Updating: very very minorly

Updating: very very minorly

(*
** Training:
** Building decision trees
*)

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

abstype data_type
typedef data = data_type

(* ****** ****** *)
//
typedef guess = bool
//
abstype feature_type = ptr
typedef feature = feature_type
//
abstype features_type = ptr
typedef features = features_type
//
(* ****** ****** *)
//
datatype dtree =
  | dtree_leaf of (guess)
  | dtree_node of (feature, dtree, dtree)
//
(* ****** ****** *)
//
extern
fun{}
DecisionTree$guess
  (xs: data): guess
extern
fun{}
DecisionTree$data_split_at
  (xs: data, f: feature): (data, data)
//
(* ****** ****** *)
//
extern
fun{}
DecisionTree$score
  (data, feature): intGte(0)
//
extern
fun{}
DecisionTree$choose_max
  (data, features): Option_vt(feature)
//
(* ****** ****** *)
//
extern
fun{}
DecisionTree$features_remove
  (fs: features, f: feature): features
//
(* ****** ****** *)
//
extern
fun{}
DecisionTree$train(data, features): dtree
//
(* ****** ****** *)

implement
{}(*tmp*)
DecisionTree$train
  (data, fs) = let
//
val opt = DecisionTree$choose_max(data, fs)
//
in
//
case+ opt of
| ~None_vt() =>
  dtree_leaf
  (
    DecisionTree$guess(data)
  ) // end of [None_vt]
| ~Some_vt(f) => let
    val fs =
      DecisionTree$features_remove(fs, f)
    // end of [val]
    val (
      data_neg, data_pos
    ) = DecisionTree$data_split_at(data, f)
    val dtree_neg =
      DecisionTree$train(data_neg, fs)
    val dtree_pos =
      DecisionTree$train(data_pos, fs)
  in
    dtree_node(f, dtree_neg, dtree_pos)
  end // end of [Some_vt]
//
end // end of [DecisionTree$train]

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

(* end of [DecisionTree_train.dats] *)

error: pathspec 'projects/LARGE/ML/CIML/DecisionTree/DecisionTree_train.dats' did not match any file(s) known to git


Updating: adding a missing file

Updating: adding a missing file

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

(* ****** ****** *)
//
// HX: prefix for external names
//
#define ATS_EXTERN_PREFIX "ats2jspre_"
//
(* ****** ****** *)

fun abs_int0 : int -> int = "mac#%"
fun neg_int0 : int -> int = "mac#%"
//
overload abs with abs_int0 of 100
overload neg with neg_int0 of 100
//
(* ****** ****** *)
//
fun succ_int0 : int -> int = "mac#%"
fun pred_int0 : int -> int = "mac#%"
//
fun succ_int1
  : {i:int} int(i) -> int(i+1) = "mac#%"
fun pred_int1
  : {i:int} int(i) -> int(i-1) = "mac#%"
//
overload succ with succ_int0 of 100
overload pred with pred_int0 of 100
//
overload succ with succ_int1 of 110
overload pred with pred_int1 of 110
//
(* ****** ****** *)
//
fun add_int0_int0: (int, int) -> int = "mac#%"
fun sub_int0_int0 : (int, int) -> int = "mac#%"
fun mul_int0_int0 : (int, int) -> int = "mac#%"
fun div_int0_int0 : (int, int) -> int = "mac#%"
//
fun add_int1_int1
  : {i,j:int} (int(i), int(j)) -> int(i+j) = "mac#%"
fun sub_int1_int1
  : {i,j:int} (int(i), int(j)) -> int(i-j) = "mac#%"
fun mul_int1_int1
  : {i,j:int} (int(i), int(j)) -> int(i*j) = "mac#%"
fun div_int1_int1
  : {i,j:int} (int(i), int(j)) -> int(i/j) = "mac#%"
//
(* ****** ****** *)
//
overload + with add_int0_int0 of 100
overload - with sub_int0_int0 of 100
overload * with mul_int0_int0 of 100
overload / with div_int0_int0 of 100
//
overload + with add_int1_int1 of 120
overload - with sub_int1_int1 of 120
overload * with mul_int1_int1 of 120
overload / with div_int1_int1 of 120
//
(* ****** ****** *)
//
fun lt_int0_int0: (int, int) -> bool = "mac#%"
fun lte_int0_int0: (int, int) -> bool = "mac#%"
fun gt_int0_int0: (int, int) -> bool = "mac#%"
fun gte_int0_int0: (int, int) -> bool = "mac#%"
//
fun eq_int0_int0: (int, int) -> bool = "mac#%"
fun neq_int0_int0: (int, int) -> bool = "mac#%"
//
fun lt_int1_int1
  : {i,j:int} (int(i), int(j)) -> bool(i < j) = "mac#%"
fun lte_int1_int1
  : {i,j:int} (int(i), int(j)) -> bool(i <= j) = "mac#%"
fun gt_int1_int1
  : {i,j:int} (int(i), int(j)) -> bool(i > j) = "mac#%"
fun gte_int1_int1
  : {i,j:int} (int(i), int(j)) -> bool(i >= j) = "mac#%"
//
fun eq_int1_int1
  : {i,j:int} (int(i), int(j)) -> bool(i == j) = "mac#%"
fun neq_int1_int1
  : {i,j:int} (int(i), int(j)) -> bool(i != j) = "mac#%"
//
(* ****** ****** *)
//
overload < with lt_int0_int0 of 100
overload <= with lte_int0_int0 of 100
overload > with gt_int0_int0 of 100
overload >= with gte_int0_int0 of 100
overload = with eq_int0_int0 of 100
overload != with neq_int0_int0 of 100
overload <> with neq_int0_int0 of 100
//
overload < with lt_int1_int1 of 120
overload <= with lte_int1_int1 of 120
overload > with gt_int1_int1 of 120
overload >= with gte_int1_int1 of 120
overload = with eq_int1_int1 of 120
overload != with neq_int1_int1 of 120
overload <> with neq_int1_int1 of 120
//
(* ****** ****** *)
//
fun print_int : (int) -> void = "mac#%"
fun prerr_int : (int) -> void = "mac#%"
//
fun
fprint_int: (FILEref, int) -> void = "mac#%"
//
overload print with print_int of 100
overload prerr with prerr_int of 100
overload fprint with fprint_int of 100
//
(* ****** ****** *)

(* end of [integer.sats] *)

error: pathspec 'projects/MEDIUM/ATS-parse-emit/JavaScript/prelude/SATS/integer.sats' did not match any file(s) known to git


Updating: scratching a bit

Updating: scratching a bit

(* ****** ****** *)
//
// HX-2014-12-23:
// For the purpose of
// studying session types
//
(* ****** ****** *)
//
abstype send (a:vt@ype)
abstype recv (a:vt@ype)
//
(* ****** ****** *)

abstype
chseq (a:type, b:type)

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

stadef nil = unit
stadef :: (a:type, b:type) = chseq (a, b)

(* ****** ****** *)
//
absvtype chpos(type)
absvtype chneg(type)
//
(* ****** ****** *)
//
extern
fun{a:vt0p}
chpos_send{ss:type}
  (ch: !chpos(send(a) :: ss) >> chpos(ss), x: a): void
extern
fun{a:vt0p}
chpos_recv{ss:type}
  (ch: !chpos(recv(a) :: ss) >> chpos(ss), x: &a? >> _): void
extern
fun{a:vt0p}
chpos_recv_val{ss:type}(ch: !chpos(recv(a) :: ss) >> chpos(ss)): a
//
(* ****** ****** *)
//
extern
fun{a:vt0p}
chneg_recv{ss:type}
  (ch: !chneg(recv(a) :: ss) >> chneg(ss), x: a): void
extern
fun{a:vt0p}
chneg_send{ss:type}
  (ch: !chneg(send(a) :: ss) >> chneg(ss), x: &a? >> _): void
extern
fun{a:vt0p}
chneg_send_val{ss:type}(ch: !chneg(send(a) :: ss) >> chneg(ss)): a
//
(* ****** ****** *)

extern
fun chpos_recv_close (ch: chpos(nil)): void
extern
fun chneg_send_close (ch: chneg(nil)): void

(* ****** ****** *)
//
extern
fun{ss:type}
chpos_chneg_connect (ch1: chpos(ss), ch2: chneg(ss)): void
//
(* ****** ****** *)

abstype service(type)

(* ****** ****** *)
//
extern
fun
service_create{ss:type}
  (f: chpos(ss) -<lincloptr1> void): service(ss)
//
extern
fun service_request{ss:type}(service(ss)): chneg(ss)
//
(* ****** ****** *)
//
datatype
sslist (a:t@ype) =
| sslist_nil of (nil)
| sslist_cons of (send(a) :: sslist(a))
//
datavtype
chpos_sslist (a:t@ype) =
| chpos_sslist_nil of ()
| chpos_sslist_cons of (chpos(send(a) :: sslist(a)))
//
(* ****** ****** *)
//
extern
fun
chpos_sslist
  {a:t0p}(chpos(sslist(a))): chpos_sslist(a)
extern
fun
chneg_sslist_nil{a:t0p}(chneg(sslist(a))): void
extern
fun
chneg_sslist_cons
  {a:t0p}(chneg(sslist(a))): chneg(send(a) :: sslist(a))
//
(* ****** ****** *)

extern
val myservice_ints : service(sslist(int))
extern
val myservice_ints_filter : service(recv(chneg(sslist(int))) :: sslist(int))

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

implement
myservice_ints = let
//
fun
fserv
(
  ch: chpos(sslist(int)), n: int
) : void = let
//
val opt = chpos_sslist(ch)
//
in
//
case+ opt of
| ~chpos_sslist_nil () => ()
| ~chpos_sslist_cons (ch) => let
    val () = chpos_send (ch, n) in fserv(ch, n+1)
  end // end of [chpos_cons]
//
end // end of [fserv]
//
in
  service_create{sslist(int)}(llam (ch) => fserv(ch, 0))
end // end of [myservice_ints]

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

implement
myservice_ints_filter = let
//
fun
aux_next
(
  p: int, ch1: chneg(sslist(int)), next0: &int? >> _
) : chneg(sslist(int)) = let
  val ch1 =
    chneg_sslist_cons (ch1)
  val next = chneg_send_val (ch1)
in
  if next % p > 0
    then (next0 := next; ch1) else aux_next (p, ch1, next0)
  // end of [if]
end // end of [aux_next]
//
fnx
fserv1
(
  ch1: chneg(sslist(int))
, ch2: chpos(sslist(int))
) : void = let
//
val opt = chpos_sslist (ch2)
//
in
//
case+ opt of
| ~chpos_sslist_nil
    () => chneg_sslist_nil (ch1)
| ~chpos_sslist_cons
    (ch2) => let
    val ch1 =
      chneg_sslist_cons (ch1)
    // end of [val]
    val first = chneg_send_val (ch1)
    val ((*void*)) = chpos_send (ch2, first)
  in
    fserv2 (first, ch1, ch2)
  end // end of [chpos_sslist_cons]
//
end // end of [fserv1]

and
fserv2
(
  p: int
, ch1: chneg(sslist(int))
, ch2: chpos(sslist(int))
) : void = let
//
val opt = chpos_sslist (ch2)
//
in
//
case opt of
| ~chpos_sslist_nil
    () => chneg_sslist_nil (ch1)
| ~chpos_sslist_cons
    (ch2) => let
    var next: int
    val ch1 = aux_next (p, ch1, next)
    val ((*void*)) = chpos_send (ch2, next)
  in
    fserv2 (p, ch1, ch2)
  end // end of [chpos_sslist_cons]
//
end // end of [fserv2]
//
in
  service_create{recv(chneg(sslist(int))) :: sslist(int)}(llam (ch) => fserv1 (chpos_recv_val(ch), ch))
end // end of [fserv]

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

extern
val myservice_primes : service(sslist(int))

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

implement
myservice_primes = let
//
fnx
fserv
(
  ch: chpos(sslist(int))
) : void = let
  val ch1 =
    service_request (myservice_ints)
  val ch1 =
    chneg_sslist_cons (ch1)
  val-(0) = chneg_send_val (ch1)
  val ch1 =
    chneg_sslist_cons (ch1)
  val-(1) = chneg_send_val (ch1)
in
  fserv2 (ch, ch1)
end // end of [fserv]
//
and
fserv2
(
  ch: chpos(sslist(int))
, ch1: chneg(sslist(int))
) : void = let
//
val opt = chpos_sslist (ch)
//
in
//
case+ opt of
| ~chpos_sslist_nil
    () => chneg_sslist_nil (ch1)
| ~chpos_sslist_cons
    (ch) => let
    val ch2 =
      service_request (myservice_ints_filter)
    // end of [val]
    val () = chneg_recv (ch2, ch1)
    val ch2 = chneg_sslist_cons (ch2)
    val first = chneg_send_val (ch2)
    val () = chpos_send (ch, first)
  in
    fserv2 (ch, ch2)
  end // end of [chpos_sslist_cons]
//
end // end of [fserv2]
//
in
  service_create{sslist(int)}(llam (ch) => fserv (ch))
end // end of [myservice_primes]

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

(* end of [scratch07.dats] *)

error: pathspec 'projects/MEDIUM/ATS-parse-emit/Erlang/SCRATCH/scratch07.dats' did not match any file(s) known to git


Updating: very minorly improving

Updating: very minorly improving

(* ****** ****** *)
//
// Title:
// Concepts of Programming Languages
// Number: CAS CS 320
// Semester: Spring 2016
// Class Time: TR 12:30-2:00
// Instructor: Hongwei Xi (hwxiATbuDOTedu)
// Teaching Fellow: Hanwen Wu (hwwuATbuDOTedu)
//
(* ****** ****** *)

#define
ATS_STATIC_PREFIX "Wormlike_keyboard_"

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

#define ATS_MAINATSFLAG 1
#define ATS_DYNLOADNAME "Wormlike_keyboard_initize"

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
(* ****** ****** *)
//
staload (*opened*) "./Wormlike.sats"
//
(* ****** ****** *)
//
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#"
//
(* ****** ****** *)

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]

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

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

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

local

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

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

fun
aux_space(): void = let
//
val opt = thePlayer_get()
//
in
//
case+ opt of
| None () => ()
| Some (x0) => player_fire_bullet(x0)
//
end // end of [aux_space]

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

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()
| _ when c = KSPACE => aux_space()
//
| _ (* ignored *) => ()
//
) (* end of [fwork_keycode] *)

in (* in-of-local *)

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

end // end of [local]

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

(* end of [Wormlike_keyboard.dats] *)

error: pathspec 'projects/SMALL/JSmygame/Wormlike/Wormlike_keyboard.dats' did not match any file(s) known to git


eight queens in ats

eight queens in ats

// Compile with `patscc -o eq eight_queens.dats`
// Run with `./qe`
// To remove all ATS2 `tmp` files `rm -fv *_[sd]ats.[co]`

// If you forget:

// SPC-c-C and puts `patscc -o eq eight_queens.dats && ./eq` to setup compilation
// SPC-c-r to recompile

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

#define N 8

typedef int8 =
(
  int, int, int, int, int, int, int, int
) // end of [int8]

fun print_dots (i: int): void =
  if i > 0 then (print ". "; print_dots (i-1)) else ()
// end of [print_dots]

fun print_row (i: int): void =
(
  print_dots (i); print "Q "; print_dots (N-i-1); print "\n";
) // end of [print_row]

fun print_board (bd: int8): void =
(
  print_row (bd.0); print_row (bd.1); print_row (bd.2); print_row (bd.3);
  print_row (bd.4); print_row (bd.5); print_row (bd.6); print_row (bd.7);
  print_newline ()
) // end of [print_board]

fun board_get
  (bd: int8, i: int): int =
  if i = 0 then bd.0
  else if i = 1 then bd.1
  else if i = 2 then bd.2
  else if i = 3 then bd.3
  else if i = 4 then bd.4
  else if i = 5 then bd.5
  else if i = 6 then bd.6
  else if i = 7 then bd.7
  else ~1 // end of [if]
// end of [board_get]

fun board_set
  (bd: int8, i: int, j:int): int8 = let
  val (x0, x1, x2, x3, x4, x5, x6, x7) = bd
in
  // This is a pretty unusual version of `let in end` construction.
  if i = 0 then let
    val x0 = j in (x0, x1, x2, x3, x4, x5, x6, x7)
  end else if i = 1 then let
    val x1 = j in (x0, x1, x2, x3, x4, x5, x6, x7)
  end else if i = 2 then let
    val x2 = j in (x0, x1, x2, x3, x4, x5, x6, x7)
  end else if i = 3 then let
    val x3 = j in (x0, x1, x2, x3, x4, x5, x6, x7)
  end else if i = 4 then let
    val x4 = j in (x0, x1, x2, x3, x4, x5, x6, x7)
  end else if i = 5 then let
    val x5 = j in (x0, x1, x2, x3, x4, x5, x6, x7)
  end else if i = 6 then let
    val x6 = j in (x0, x1, x2, x3, x4, x5, x6, x7)
  end else if i = 7 then let
    val x7 = j in (x0, x1, x2, x3, x4, x5, x6, x7)
  end else bd // end of [if]
end // end of [board_set]

fun safety_test1
(
  i0: int, j0: int, i1: int, j1: int
) : bool =
(*
** [abs]: the absolute value function
*)
  j0 != j1 andalso abs (i0 - i1) != abs (j0 - j1)
// end of [safety_test1]

fun safety_test2
(
  i0: int, j0: int, bd: int8, i: int
) : bool =
  if i >= 0 then
    if safety_test1 (i0, j0, i, board_get (bd, i))
      then safety_test2 (i0, j0, bd, i-1) else false
    // end of [if]
  else true // end of [if]
// end of [safety_test2]

fun search
(
  bd: int8, i: int, j: int, nsol: int
) : int = (
//
if
(j < N)
then let
  val test = safety_test2 (i, j, bd, i-1)
in
  if test
    then let
      val bd1 = board_set (bd, i, j)
    in
      if i+1 = N
        then let
          val () = print! ("Solution #", nsol+1, ":\n\n")
          val () = print_board (bd1)
        in
          search (bd, i, j+1, nsol+1)
        end // end of [then]
        else (
          search (bd1, i+1, 0(*j*), nsol) // positioning next piece
        ) (* end of [else] *)
      // end of [if]
    end // end of [then]
    else search (bd, i, j+1, nsol)
  // end of [if]
end // end of [then]
else (
  if i > 0
    then search (bd, i-1, board_get (bd, i-1) + 1, nsol) else nsol
  // end of [if]
) (* end of [else] *)
//
) (* end of [search] *)

implement main0 () = let
  val board = (0, 1, 2, 3, 4, 5, 6, 7): int8
in
  print_board(board)
end

error: pathspec 'ats/introduction_to_programming_in_ats/eight_queens.dats' did not match any file(s) known to git


Updating: adding atscc2py3/queens_comb

Updating: adding atscc2py3/queens_comb

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

(*
** Author: Hongwei Xi
** Authoremail: gmhwxiATgmailDOTcom
** Time: the 26th of July, 2016
*)

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

#define N 8 // HX: N can be changed

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

macdef sing = stream_make_sing
macdef intrange = list0_make_intrange

(* ****** ****** *)
//
extern
fun
main0_py
(
// argless
) : void = "mac#main0_py"
//
implement
main0_py () =
{
//
val () =
(((fix qsolve(n: int): stream(list0(int)) => if(n > 0)then((qsolve(n-1)*intrange(0,N)).map(TYPE{list0(int)})(lam($tup(xs,x))=>cons0(x,xs))).filter()(lam(xs)=>let val-cons0(x0,xs) = xs in xs.iforall()(lam(i, x)=>((x0)!=x)&&(abs(x0-x)!=i+1)) end)else(sing(nil0())))(N)).takeLte(10)).iforeach()(lam(i, xs)=>(println!("Solution#", i+1, ":"); xs.rforeach()(lam(x) => ((N).foreach()(lam(i)=>(print_string(ifval(i=x," Q", " ."))));println!()));println!()))
//
} (* end of [main0_py] *)
//
(* ****** ****** *)

%{^
import sys
######
sys.setrecursionlimit(1000000)
sys.path.append("./libatscc2py3")
######
from libatscc2py_all import *
######
%} // end of [%{^]

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

%{$
######
main0_py()
######
%} (* end of [%{$] *)

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

(* end of [queens_comb.dats] *)

error: pathspec 'projects/MEDIUM/CATS-atsccomp/CATS-atscc2py3/TEST/queens_comb.dats' did not match any file(s) known to git