Updating: very minorly tidying-up

Updating: very minorly tidying-up

(* ****** ****** *)
//
// CATS-parsemit
//
(* ****** ****** *)
//
(*
The MIT License (MIT)

Copyright (c) 2014 Hongwei Xi

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 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.
*)
//
(* ****** ****** *)
//
// HX-2014-07-02: start
//
(* ****** ****** *)

#define ATS_PACKNAME "CATSPARSE"

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
(* ****** ****** *)
//
typedef
fprint_type
  (a:t@ype) = (FILEref, a) -> void
//
(* ****** ****** *)
//
staload
SBF =
"libats/SATS/stringbuf.sats"
//
stadef stringbuf = $SBF.stringbuf
//
(* ****** ****** *)
//
staload
DA =
"libats/SATS/dynarray.sats"
//
stadef dynarr = $DA.dynarray
//
(* ****** ****** *)
//
staload
CS =
"{$LIBATSHWXI}\
/cstream/SATS/cstream.sats"
//
stadef cstream = $CS.cstream
//
(* ****** ****** *)

exception FatalErrorExn
fun abort ((*void*)):<!exn> void

(* ****** ****** *)
//
abstype
filename_type = ptr
typedef fil_t = filename_type
//
(* ****** ****** *)

val filename_dummy : fil_t
val filename_stdin : fil_t

(* ****** ****** *)
//
fun
filename_make (path: string): fil_t
//
(* ****** ****** *)
//
fun print_filename : (fil_t) -> void
fun prerr_filename : (fil_t) -> void
fun fprint_filename : fprint_type (fil_t)
//
overload print with print_filename
overload prerr with prerr_filename
overload fprint with fprint_filename
//
(* ****** ****** *)
//
fun the_filename_pop ((*void*)): fil_t
fun the_filename_push (fil: fil_t): void
//
fun the_filename_get ((*void*)): fil_t
//
(* ****** ****** *)
(*
//
abstype
position_type = ptr
typedef pos_t = position_type
//
(* ****** ****** *)
//
fun print_position : (pos_t) -> void
fun prerr_position : (pos_t) -> void
fun fprint_position : fprint_type (pos_t)
//
overload print with print_position
overload prerr with prerr_position
overload fprint with fprint_position
//
*)
(* ****** ****** *)

typedef
position =
@{
, pos_ntot= int
, pos_nrow= int
, pos_ncol= int
} (* end of [position] *)

(* ****** ****** *)
//
fun
position_byrow (pos: &position >> _): void
//
(* ****** ****** *)
//
fun
position_incby1 (pos: &position >> _): void
//
fun
position_incby (pos: &position >> _, n: intGte(0)): void
fun
position_decby (pos: &position >> _, n: intGte(0)): void
//
fun position_incby_char (pos: &position >> _, c: char): void
//
(* ****** ****** *)
//
abstype
location_type = ptr
typedef loc_t = location_type
//
(* ****** ****** *)

val location_dummy : loc_t

(* ****** ****** *)
//
fun print_location : (loc_t) -> void
fun prerr_location : (loc_t) -> void
fun fprint_location : fprint_type (loc_t)
//
overload print with print_location
overload prerr with prerr_location
overload fprint with fprint_location
//
fun fprint_locrange : fprint_type (loc_t)
//
(* ****** ****** *)
//
fun
location_make_pos_pos
  (pos1: &position, pos2: &position): loc_t
fun
location_make_fil_pos_pos
(
  fil: fil_t, pos1: &position, pos2: &position
) : loc_t // end-of-function
//
(* ****** ****** *)
//
fun
location_combine (loc1: loc_t, loc2: loc_t): loc_t
//
(* ****** ****** *)

datatype
keyword =
//
  | SRPif of () // #if
  | SRPifdef of () // #ifdef
  | SRPifndef of () // #ifndef
  | SRPendif of () // #endif
//
  | SRPline of () // #line
  | SRPinclude of () // #include
//
  | TYPEDEF of ()
  | ATSstruct of ()
//
  | ATSinline of () // inline
  | ATSextern of () // extern
  | ATSstatic of () // static
//
  | ATSassume of ()
//
  | ATSdyncst_mac of ()
//
  | ATSdyncst_extfun of ()
//
  | ATSdyncst_valdec of ()
  | ATSdyncst_valimp of ()
//
  | ATStmpdec of ()
  | ATStmpdec_void of ()
//
  | ATSstatmpdec of ()
  | ATSstatmpdec_void of ()
//
  | ATSif of ()
  | ATSthen of ()
  | ATSelse of ()
//
  | ATSifthen of ()
  | ATSifnthen of ()
//
  | ATSbranch_beg of ()
  | ATSbranch_end of ()
//
  | ATScaseof_beg of ()
  | ATScaseof_end of ()
//
  | ATSextcode_beg of ()
  | ATSextcode_end of ()
//
  | ATSfunbody_beg of ()
  | ATSfunbody_end of ()
//
  | ATSreturn of ()
  | ATSreturn_void of ()
//
  | ATSPMVint of ()
  | ATSPMVintrep of ()
  | ATSPMVbool_true of ()
  | ATSPMVbool_false of ()
  | ATSPMVfloat of ()
  | ATSPMVstring of ()
//
  | ATSPMVi0nt of ()
  | ATSPMVf0loat of ()
//
  | ATSPMVempty of ()
  | ATSPMVextval of ()
//
  | ATSPMVrefarg0 of ()
  | ATSPMVrefarg1 of ()
//
  | ATSPMVfunlab of ()
  | ATSPMVcfunlab of ()
//
  | ATSPMVcastfn of ()
//
  | ATSCSTSPmyloc of ()
//
  | ATSCKiseqz of ()
  | ATSCKisneqz of ()
  | ATSCKptriscons of ()
  | ATSCKptrisnull of ()
//
  | ATSCKpat_int of ()
  | ATSCKpat_bool of ()
  | ATSCKpat_string of ()
//
  | ATSCKpat_con0 of ()
  | ATSCKpat_con1 of ()
//
  | ATSSELcon of ()
  | ATSSELrecsin of ()
  | ATSSELboxrec of ()
  | ATSSELfltrec of ()
//
  | ATSextfcall of ()
  | ATSextmcall of ()
//
  | ATSfunclo_fun of ()
  | ATSfunclo_clo of ()
//
  | ATSINSlab of ()
  | ATSINSgoto of ()
//
  | ATSINSflab of ()
  | ATSINSfgoto of ()
//
  | ATSINSfreeclo of ()
  | ATSINSfreecon of ()
//
  | ATSINSmove of ()
  | ATSINSmove_void of ()
//
  | ATSINSmove_nil of ()
  | ATSINSmove_con0 of ()
  | ATSINSmove_con1_beg of ()
  | ATSINSmove_con1_end of ()
  | ATSINSmove_con1_new of ()
  | ATSINSstore_con1_tag of ()
  | ATSINSstore_con1_ofs of ()
//
  | ATSINSmove_boxrec_beg of ()
  | ATSINSmove_boxrec_end of ()
  | ATSINSmove_boxrec_new of ()
  | ATSINSstore_boxrec_ofs of ()
//
  | ATSINSmove_fltrec_beg of ()
  | ATSINSmove_fltrec_end of ()
  | ATSINSstore_fltrec_ofs of ()
//
  | ATSINSmove_delay of ()
  | ATSINSmove_lazyeval of ()
//
  | ATStailcal_beg of ()
  | ATStailcal_end of ()
  | ATSINSmove_tlcal of ()
  | ATSINSargmove_tlcal of ()
//
  | ATSINSextvar_assign of ()
  | ATSINSdyncst_valbind of ()
//
  | ATSINScaseof_fail of ()
  | ATSINSdeadcode_fail of ()
//
  | ATSdynload of ()
  | ATSdynloadset of ()
  | ATSdynloadfcall of ()
  | ATSdynloadflag_sta of ()
  | ATSdynloadflag_ext of ()
  | ATSdynloadflag_init of ()
  | ATSdynloadflag_minit of ()
//
  | ATSclosurerize_beg of ()
  | ATSclosurerize_end of ()
//
  | KWORDnone of () // for indicating a non-keyword
//
// end of [keyword]

(* ****** ****** *)
//
fun print_keyword : (keyword) -> void
fun prerr_keyword : (keyword) -> void
fun fprint_keyword: fprint_type (keyword)
//
overload print with print_keyword
overload prerr with prerr_keyword
overload fprint with fprint_keyword
//
(* ****** ****** *)

fun keyword_search (name: string): keyword

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

datatype
token_node =
//
| T_KWORD of keyword
//
| T_IDENT_alp of string
| T_IDENT_sym of string
| T_IDENT_srp of string
//
| T_CHAR of (string)
//
| T_INT of (int(*base*), string)
| T_FLOAT of (int(*base*), string)
//
| T_STRING of (string)
//
| T_LPAREN of () // (
| T_RPAREN of () // )
| T_LBRACKET of () // [
| T_RBRACKET of () // ]
| T_LBRACE of () // {
| T_RBRACE of () // }
//
| T_LT of ()
| T_GT of ()
//
| T_MINUS of ()
//
| T_COLON of () // :
//
| T_COMMA of () // ,
| T_SEMICOLON of () // ;
//
| T_SLASH of () // /
//
| T_ENDL of ()
| T_SPACES of (string)
//
| T_COMMENT_line of (string) // line comment
| T_COMMENT_block of (string) // block comment
//
| T_EOF of () // end-of-file
//
// end of [token_node]

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

typedef tnode = token_node

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

typedef token = '{
  token_loc= loc_t, token_node= tnode
} (* end of [token] *)

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

typedef tokenlst = List0 (token)
typedef tokenopt = Option (token)

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

fun token_get_loc (token): loc_t

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

fun fprint_tnode : fprint_type (tnode)

(* ****** ****** *)
//
fun print_token : (token) -> void
fun prerr_token : (token) -> void
fun fprint_token : fprint_type (token)
//
overload print with print_token
overload prerr with prerr_token
overload fprint with fprint_token
//
(* ****** ****** *)
//
fun
token_make (loc: loc_t, node: tnode): token
//
(* ****** ****** *)

typedef i0nt = token
typedef f0loat = token
typedef s0tring = token

(* ****** ****** *)
//
datatype
lexerr_node =
  | LEXERR_FEXPONENT_nil of ()
  | LEXERR_UNSUPPORTED_char of (char)
//
typedef lexerr = '{
  lexerr_loc= loc_t, lexerr_node= lexerr_node
} (* end of [lexerr] *)
//
typedef lexerrlst = List0 (lexerr)
//
(* ****** ****** *)
//
fun print_lexerr (lexerr): void
fun prerr_lexerr (lexerr): void
//
fun fprint_lexerr : fprint_type (lexerr)
fun fprint_lexerrlst : fprint_type (lexerrlst)
//
overload print with print_lexerr
overload prerr with prerr_lexerr
overload fprint with fprint_lexerr
//
(* ****** ****** *)
//
fun
lexerr_make
  (loc: loc_t, node: lexerr_node): lexerr
//
(* ****** ****** *)
//
fun the_lexerrlst_clear (): void
//
fun the_lexerrlst_insert (err: lexerr): void
//
fun the_lexerrlst_pop_all ((*void*)): List0_vt(lexerr)
//
fun the_lexerrlst_print_free ((*void*)): int(*nerr*)
//
(* ****** ****** *)
//
vtypedef
_lexbuf_vt0ype =
@{
//
lexbuf_ntot= int
,
lexbuf_nrow= int
,
lexbuf_ncol= int
,
//
lexbuf_nspace= int
//
,
//
lexbuf_cstream= cstream
//
,
lexbuf_nback= int
,
lexbuf_stringbuf= stringbuf
//
} // end of [_lexbuf_vt0ype]

(* ****** ****** *)
//
absvt@ype
lexbuf_vt0ype = _lexbuf_vt0ype
//
vtypedef lexbuf = lexbuf_vt0ype
//
(* ****** ****** *)
//
fun
lexbuf_initize_string
  (buf: &lexbuf? >> _, inp: string): void
fun
lexbuf_initize_fileref
  (buf: &lexbuf? >> _, inp: FILEref): void
//
(* ****** ****** *)

fun lexbuf_uninitize (buf: &lexbuf >> _?): void

(* ****** ****** *)
//
fun
lexbuf_set_position
  (buf: &lexbuf >> _, pos: &position): void
fun
lexbuf_get_position
  (buf: &lexbuf, pos: &position? >> _): void
//
(* ****** ****** *)

fun lexbuf_set_nback (buf: &lexbuf, nb: int): void
fun lexbuf_incby_nback (buf: &lexbuf, nb: int): void

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

fun lexbuf_get_nspace (buf: &lexbuf): int
fun lexbuf_set_nspace (buf: &lexbuf, n: int): void

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

fun lexbuf_remove
  (buf: &lexbuf >> _, nchr: intGte(0)): void

fun lexbuf_remove_all (buf: &lexbuf >> _): void

(* ****** ****** *)
//
fun lexbuf_takeout
  (buf: &lexbuf >> _, nchr: intGte(0)): Strptr1
//
(* ****** ****** *)

fun lexbuf_get_char (buf: &lexbuf >> _): int

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

fun lexbuf_get_token_any (buf: &lexbuf >> _): token
fun lexbuf_get_token_skip (buf: &lexbuf >> _): token

(* ****** ****** *)
//
fun lexbufpos_get_location (buf: &lexbuf, pos: &position) : loc_t
//
fun lexbuf_getbyrow_location (buf: &lexbuf): loc_t
fun lexbuf_getincby_location (buf: &lexbuf, nchr: intGte(0)): loc_t
//
(* ****** ****** *)

vtypedef
_tokbuf_vt0ype =
@{
//
  tokbuf_tkbf= dynarr(token)
, tokbuf_ntok= size_t, tokbuf_lxbf= lexbuf
//
} (* end of [_tokbuf_vt0ype] *)

(* ****** ****** *)
//
absvt@ype
tokbuf_vt0ype = _tokbuf_vt0ype
//
vtypedef tokbuf = tokbuf_vt0ype
//
(* ****** ****** *)
//
fun
tokbuf_initize_string
  (buf: &tokbuf? >> _, inp: string): void
fun
tokbuf_initize_fileref
  (buf: &tokbuf? >> _, inp: FILEref): void
//
(* ****** ****** *)

fun tokbuf_reset (buf: &tokbuf >> _): void

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

fun tokbuf_uninitize (buf: &tokbuf >> _?): void

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

fun
tokbuf_get_ntok (buf: &tokbuf >> _): size_t
fun
tokbuf_set_ntok (buf: &tokbuf >> _, ntok: size_t): void

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

fun
tokbuf_incby1 (buf: &tokbuf >> _): void
fun
tokbuf_incby_count (buf: &tokbuf >> _, n: size_t): void

(* ****** ****** *)
//
fun
tokbuf_get_token (buf: &tokbuf >> _): token
fun
tokbuf_get_token_any (buf: &tokbuf >> _): token
//
fun
tokbuf_getinc_token (buf: &tokbuf >> _): token
//
(* ****** ****** *)

fun
tokbuf_get_location (buf: &tokbuf >> _): loc_t

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

abstype symbol_type = ptr
typedef symbol = symbol_type

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

fun symbol_make (name: string): symbol

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

fun symbol_get_name (x: symbol):<> string

(* ****** ****** *)
//
fun print_symbol : (symbol) -> void
fun prerr_symbol : (symbol) -> void
fun fprint_symbol : fprint_type (symbol)
//
overload print with print_symbol
overload prerr with prerr_symbol
overload fprint with fprint_symbol
//
(* ****** ****** *)
//
fun eq_symbol_symbol
  : (symbol, symbol) -<0> bool
//
overload = with eq_symbol_symbol
//
(* ****** ****** *)
//
abstype synent_type = ptr
typedef synent = synent_type
//
(* ****** ****** *)
//
datatype
signed = SIGNED of (loc_t, int)
//
(* ****** ****** *)

typedef
i0de = '{
  i0dex_loc= loc_t, i0dex_sym= symbol
} (* end of [i0de] *)

(* ****** ****** *)
//
fun print_i0de : i0de -> void
fun prerr_i0de : i0de -> void
fun fprint_i0de : fprint_type (i0de)
//
overload print with print_i0de
overload prerr with prerr_i0de
overload fprint with fprint_i0de
//
(* ****** ****** *)

typedef label = i0de
typedef labelist = List0 (label)
vtypedef labelist_vt = List0_vt (label)

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

datatype
s0exp_node =
  | S0Eide of symbol
  | S0Elist of (s0explst) // temp
  | S0Eappid of (i0de, s0explst)
// end of [s0exp_node]

where
s0exp = '{
  s0exp_loc= loc_t, s0exp_node= s0exp_node
} (* end of [s0exp] *)

and s0explst = List0 (s0exp)
and s0expopt = Option (s0exp)

(* ****** ****** *)
//
fun print_s0exp : s0exp -> void
fun prerr_s0exp : s0exp -> void
fun fprint_s0exp : fprint_type (s0exp)
fun fprint_s0explst : fprint_type (s0explst)
//
overload print with print_s0exp
overload prerr with prerr_s0exp
overload fprint with fprint_s0exp
overload fprint with fprint_s0explst of 10
//
(* ****** ****** *)
//
datatype
tyfld_node =
TYFLD of (i0de, s0exp)
typedef
tyfld = '{
  tyfld_loc= loc_t
, tyfld_node= tyfld_node
} (* end of [tyfld] *)
//
typedef tyfldlst = List0 (tyfld)
//
typedef tyrec = '{
  tyrec_loc= loc_t, tyrec_node= tyfldlst
} (* end of [tyrec] *)
//
(* ****** ****** *)

datatype
d0exp_node =
  | D0Eide of (i0de)
  | D0Elist of (d0explst) // temp
  | D0Eappid of (i0de, d0explst)
  | D0Eappexp of (d0exp, d0explst)
//
  | ATSPMVint of i0nt
  | ATSPMVintrep of i0nt
  | ATSPMVbool of bool
  | ATSPMVfloat of f0loat
  | ATSPMVstring of s0tring
//
  | ATSPMVi0nt of i0nt
  | ATSPMVf0loat of f0loat
//
  | ATSPMVempty of (int) // void-value
  | ATSPMVextval of (tokenlst) // external values
//
  | ATSPMVrefarg0 of (d0exp)
  | ATSPMVrefarg1 of (d0exp)
//
  | ATSPMVfunlab of (label)
  | ATSPMVcfunlab of (int(*knd*), label, d0explst)
//
  | ATSPMVcastfn of (i0de(*fun*), s0exp, d0exp(*arg*))
//
  | ATSCSTSPmyloc of s0tring
//
  | ATSCKiseqz of (d0exp)
  | ATSCKisneqz of (d0exp)
  | ATSCKptriscons of (d0exp)
  | ATSCKptrisnull of (d0exp)
//
  | ATSCKpat_int of (d0exp, d0exp)
  | ATSCKpat_bool of (d0exp, d0exp)
  | ATSCKpat_string of (d0exp, d0exp)
//
  | ATSCKpat_con0 of (d0exp, int(*tag*))
  | ATSCKpat_con1 of (d0exp, int(*tag*))
//
  | ATSSELcon of (d0exp, s0exp(*tysum*), i0de(*lab*))
  | ATSSELrecsin of (d0exp, s0exp(*tyrec*), i0de(*lab*))
  | ATSSELboxrec of (d0exp, s0exp(*tyrec*), i0de(*lab*))
  | ATSSELfltrec of (d0exp, s0exp(*tyrec*), i0de(*lab*))
//
  | ATSextfcall of
      (i0de(*fun*), d0explst(*arg*))
    // end of [ATSextfcall]
  | ATSextmcall of
      (d0exp(*obj*), d0exp(*method*), d0explst(*arg*))
    // end of [ATSextmcall]
//
  | ATSfunclo_fun of (d0exp, s0exp(*arg*), s0exp(*res*))
  | ATSfunclo_clo of (d0exp, s0exp(*arg*), s0exp(*res*))
//
// end of [d0exp_node]

where
d0exp = '{
  d0exp_loc= loc_t, d0exp_node= d0exp_node
} (* end of [d0exp] *)

and d0explst = List0 (d0exp)
and d0expopt = Option (d0exp)

(* ****** ****** *)
//
fun print_d0exp : d0exp -> void
fun prerr_d0exp : d0exp -> void
fun fprint_d0exp : fprint_type (d0exp)
fun fprint_d0explst : fprint_type (d0explst)
//
overload print with print_d0exp
overload prerr with prerr_d0exp
overload fprint with fprint_d0exp
overload fprint with fprint_d0explst of 10
//
(* ****** ****** *)

datatype
f0arg_node =
  | F0ARGnone of (s0exp)
  | F0ARGsome of (i0de, s0exp)
// end of [f0arg_node]

typedef
f0arg = '{
  f0arg_loc= loc_t, f0arg_node= f0arg_node
} (* end of [f0arg] *)

typedef f0arglst = List0 (f0arg)

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

typedef
f0marg = '{
  f0marg_loc= loc_t, f0marg_node= f0arglst
} (* end of [f0marg] *)

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

datatype
fkind_node =
  | FKextern of () | FKstatic of ()
// end of [fkind_node]

typedef fkind = '{
  fkind_loc= loc_t, fkind_node= fkind_node
} (* end of [fkind] *)

(* ****** ****** *)
//
datatype
f0head_node =
F0HEAD of (i0de, f0marg, s0exp)
//
typedef
f0head = '{
  f0head_loc= loc_t, f0head_node= f0head_node
} (* end of [f0head] *)
//
(* ****** ****** *)

typedef f0headopt = Option (f0head)

(* ****** ****** *)
//
fun fprint_f0arg : fprint_type (f0arg)
fun fprint_f0marg : fprint_type (f0marg)
fun fprint_fkind : fprint_type (fkind)
fun fprint_f0head : fprint_type (f0head)
//
overload fprint with fprint_f0arg
overload fprint with fprint_f0marg
overload fprint with fprint_fkind
overload fprint with fprint_f0head
//
(* ****** ****** *)
//
fun
f0marg_isneqz (f0ma: f0marg): bool
//
overload isneqz with f0marg_isneqz
//
(* ****** ****** *)
//
datatype
tmpdec_node =
| TMPDECnone of (i0de)
| TMPDECsome of (i0de, s0exp)
//
typedef
tmpdec = '{
  tmpdec_loc= loc_t, tmpdec_node= tmpdec_node
} (* end of [tmpdec] *)
//
typedef tmpdeclst = List0 (tmpdec)
//
(* ****** ****** *)
//
fun fprint_tmpdec: fprint_type(tmpdec)
fun fprint_tmpdeclst: fprint_type(tmpdeclst)
//
overload fprint with fprint_tmpdec
overload fprint with fprint_tmpdeclst
//
(* ****** ****** *)
//
datatype
instr_node =
//
  | ATSif of (
      d0exp // HX: cond
    , instrlst // HX: then
    , instrlstopt // HX: else
    ) (* end of [ATSif] *)
//
  | ATSthen of instrlst // temp
  | ATSelse of instrlst // temp
//
  | ATSifthen of (d0exp, instrlst)
  | ATSifnthen of (d0exp, instrlst)
//
  | ATSbranchseq of (instrlst)
  | ATScaseofseq of (instrlst(*branches*))
//
  | ATSfunbodyseq of instrlst
//
  | ATSreturn of (i0de)
  | ATSreturn_void of (i0de)
//
  | ATSlinepragma of (token(*line*), token(*file*))
//
  | ATSINSlab of (label)
  | ATSINSgoto of (label)
//
  | ATSINSflab of (label)
  | ATSINSfgoto of (label)
//
  | ATSINSfreeclo of (d0exp)
  | ATSINSfreecon of (d0exp)
//
  | ATSINSmove of (i0de, d0exp)
  | ATSINSmove_void of (i0de, d0exp)
//
  | ATSINSmove_nil of (i0de)
  | ATSINSmove_con0 of (i0de, token(*tag*))
//
  | ATSINSmove_con1 of (instrlst)
  | ATSINSmove_con1_new of (i0de, s0exp)
  | ATSINSstore_con1_tag of (i0de, token(*tag*))
  | ATSINSstore_con1_ofs of (i0de, s0exp, i0de, d0exp)
//
  | ATSINSmove_boxrec of (instrlst)
  | ATSINSmove_boxrec_new of (i0de, s0exp)
  | ATSINSstore_boxrec_ofs of (i0de, s0exp, i0de, d0exp)
//
  | ATSINSmove_fltrec of (instrlst)
  | ATSINSstore_fltrec_ofs of (i0de, s0exp, i0de, d0exp)
//
  | ATSINSmove_delay of (i0de, s0exp, d0exp)
  | ATSINSmove_lazyeval of (i0de, s0exp, d0exp)
//
  | ATStailcalseq of instrlst
  | ATSINSmove_tlcal of (i0de, d0exp)
  | ATSINSargmove_tlcal of (i0de, i0de)
//
  | ATSINSextvar_assign of (d0exp, d0exp)
  | ATSINSdyncst_valbind of (i0de, d0exp)
//
  | ATSINScaseof_fail of (token)
  | ATSINSdeadcode_fail of (token)
//
  | ATSdynload of int
  | ATSdynloadset of (i0de)
  | ATSdynloadfcall of (i0de)
  | ATSdynloadflag_sta of (i0de)
  | ATSdynloadflag_ext of (i0de)
  | ATSdynloadflag_init of (i0de)
  | ATSdynloadflag_minit of (i0de)
//
// end of [instr_node]
//
where
instr = '{
  instr_loc= loc_t, instr_node= instr_node
} (* end of [instr] *)
//
and instrlst = List0 (instr)
and instropt = Option (instr)
and instrlstopt = Option (instrlst)
//
vtypedef
instrlst_vt = List0_vt (instr)
//
(* ****** ****** *)
//
fun fprint_instr : fprint_type (instr)
fun fprint_instrlst : fprint_type (instrlst)
//
overload fprint with fprint_instr
overload fprint with fprint_instrlst of 10
//
(* ****** ****** *)

datatype
f0body_node =
F0BODY of (tmpdeclst, instrlst)
//
typedef f0body = '{
  f0body_loc= loc_t, f0body_node= f0body_node
} (* end of [f0body] *)

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

datatype
f0decl_node =
  | F0DECLnone of (f0head)
  | F0DECLsome of (f0head, f0body)
// end of [f0decl_node]

typedef
f0decl = '{
  f0decl_loc= loc_t, f0decl_node= f0decl_node
} (* end of [f0decl] *)

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

fun
fprint_f0decl:fprint_type (f0decl)
overload fprint with fprint_f0decl

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

datatype
d0ecl_node =
//
  | D0Cinclude of s0tring
//
  | D0Cifdef of (i0de, d0eclist)
  | D0Cifndef of (i0de, d0eclist)
//
  | D0Ctypedef of (i0de, tyrec)
//
  | D0Cassume of i0de // HX: assume ...
//
  | D0Cdyncst_mac of i0de
//
  | D0Cdyncst_extfun of (i0de, s0explst, s0exp)
//
  | D0Cdyncst_valdec of (i0de, s0exp)
  | D0Cdyncst_valimp of (i0de, s0exp)
//
  | D0Cextcode of (tokenlst)
//
  | D0Cstatmp of (i0de, s0expopt)
//
  | D0Cfundecl of (fkind, f0decl)
//
  | D0Cclosurerize of (
      i0de, s0exp(*env*), s0exp(*arg*), s0exp(*res*)
    ) (* end of [D0Cclosurerize] *)
//
  | D0Cdynloadflag_init of (i0de)
  | D0Cdynloadflag_minit of (i0de)
//
// end of [d0ecl_node]

where
d0ecl = '{
//
d0ecl_loc= loc_t, d0ecl_node= d0ecl_node
//
} (* end of [d0ecl] *)

and
d0eclist = List0 (d0ecl)

(* ****** ****** *)
//
fun fprint_d0ecl : fprint_type (d0ecl)
fun fprint_d0eclist : fprint_type (d0eclist)
//
overload fprint with fprint_d0ecl
overload fprint with fprint_d0eclist of 10
//
(* ****** ****** *)

(* end of [catsparse.sats] *)

(* ****** ****** *)
//
// CATS-parsemit
//
(* ****** ****** *)
//
(*
The MIT License (MIT)

Copyright (c) 2014 Hongwei Xi

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 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.
*)
//
(* ****** ****** *)
//
// HX-2014-07-02: start
//
(* ****** ****** *)

#define ATS_PACKNAME "CATSPARSE"

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
(* ****** ****** *)
//
typedef
fprint_type
  (a:t@ype) = (FILEref, a) -> void
//
(* ****** ****** *)
//
staload
SBF =
"libats/SATS/stringbuf.sats"
//
stadef stringbuf = $SBF.stringbuf
//
(* ****** ****** *)
//
staload
DA =
"libats/SATS/dynarray.sats"
//
stadef dynarray = $DA.dynarray
//
(* ****** ****** *)
//
staload
CS = "{$LIBATSHWXI}/cstream/SATS/cstream.sats"
stadef cstream = $CS.cstream
//
(* ****** ****** *)

exception FatalErrorExn
fun abort ((*void*)):<!exn> void

(* ****** ****** *)
//
abstype
filename_type = ptr
typedef fil_t = filename_type
//
(* ****** ****** *)

val filename_dummy : fil_t
val filename_stdin : fil_t

(* ****** ****** *)
//
fun
filename_make (path: string): fil_t
//
(* ****** ****** *)
//
fun print_filename : (fil_t) -> void
fun prerr_filename : (fil_t) -> void
fun fprint_filename : fprint_type (fil_t)
//
overload print with print_filename
overload prerr with prerr_filename
overload fprint with fprint_filename
//
(* ****** ****** *)
//
fun the_filename_pop ((*void*)): fil_t
fun the_filename_push (fil: fil_t): void
//
fun the_filename_get ((*void*)): fil_t
//
(* ****** ****** *)
(*
//
abstype
position_type = ptr
typedef pos_t = position_type
//
(* ****** ****** *)
//
fun print_position : (pos_t) -> void
fun prerr_position : (pos_t) -> void
fun fprint_position : fprint_type (pos_t)
//
overload print with print_position
overload prerr with prerr_position
overload fprint with fprint_position
//
*)
(* ****** ****** *)

typedef
position =
@{
, pos_ntot= int
, pos_nrow= int
, pos_ncol= int
} (* end of [position] *)

(* ****** ****** *)
//
fun
position_byrow (pos: &position >> _): void
//
(* ****** ****** *)
//
fun
position_incby1 (pos: &position >> _): void
//
fun
position_incby (pos: &position >> _, n: intGte(0)): void
fun
position_decby (pos: &position >> _, n: intGte(0)): void
//
fun position_incby_char (pos: &position >> _, c: char): void
//
(* ****** ****** *)
//
abstype
location_type = ptr
typedef loc_t = location_type
//
(* ****** ****** *)

val location_dummy : loc_t

(* ****** ****** *)
//
fun print_location : (loc_t) -> void
fun prerr_location : (loc_t) -> void
fun fprint_location : fprint_type (loc_t)
//
overload print with print_location
overload prerr with prerr_location
overload fprint with fprint_location
//
fun fprint_locrange : fprint_type (loc_t)
//
(* ****** ****** *)
//
fun
location_make_pos_pos
  (pos1: &position, pos2: &position): loc_t
fun
location_make_fil_pos_pos
(
  fil: fil_t, pos1: &position, pos2: &position
) : loc_t // end-of-function
//
(* ****** ****** *)
//
fun
location_combine (loc1: loc_t, loc2: loc_t): loc_t
//
(* ****** ****** *)

datatype
keyword =
//
  | SRPif of () // #if
  | SRPifdef of () // #ifdef
  | SRPifndef of () // #ifndef
  | SRPendif of () // #endif
//
  | SRPline of () // #line
  | SRPinclude of () // #include
//
  | TYPEDEF of ()
  | ATSstruct of ()
//
  | ATSinline of () // inline
  | ATSextern of () // extern
  | ATSstatic of () // static
//
  | ATSassume of ()
//
  | ATSdyncst_mac of ()
//
  | ATSdyncst_extfun of ()
//
  | ATSdyncst_valdec of ()
  | ATSdyncst_valimp of ()
//
  | ATStmpdec of ()
  | ATStmpdec_void of ()
//
  | ATSstatmpdec of ()
  | ATSstatmpdec_void of ()
//
  | ATSif of ()
  | ATSthen of ()
  | ATSelse of ()
//
  | ATSifthen of ()
  | ATSifnthen of ()
//
  | ATSbranch_beg of ()
  | ATSbranch_end of ()
//
  | ATScaseof_beg of ()
  | ATScaseof_end of ()
//
  | ATSextcode_beg of ()
  | ATSextcode_end of ()
//
  | ATSfunbody_beg of ()
  | ATSfunbody_end of ()
//
  | ATSreturn of ()
  | ATSreturn_void of ()
//
  | ATSPMVint of ()
  | ATSPMVintrep of ()
  | ATSPMVbool_true of ()
  | ATSPMVbool_false of ()
  | ATSPMVfloat of ()
  | ATSPMVstring of ()
//
  | ATSPMVi0nt of ()
  | ATSPMVf0loat of ()
//
  | ATSPMVempty of ()
  | ATSPMVextval of ()
//
  | ATSPMVrefarg0 of ()
  | ATSPMVrefarg1 of ()
//
  | ATSPMVfunlab of ()
  | ATSPMVcfunlab of ()
//
  | ATSPMVcastfn of ()
//
  | ATSCSTSPmyloc of ()
//
  | ATSCKiseqz of ()
  | ATSCKisneqz of ()
  | ATSCKptriscons of ()
  | ATSCKptrisnull of ()
//
  | ATSCKpat_int of ()
  | ATSCKpat_bool of ()
  | ATSCKpat_string of ()
//
  | ATSCKpat_con0 of ()
  | ATSCKpat_con1 of ()
//
  | ATSSELcon of ()
  | ATSSELrecsin of ()
  | ATSSELboxrec of ()
  | ATSSELfltrec of ()
//
  | ATSextfcall of ()
  | ATSextmcall of ()
//
  | ATSfunclo_fun of ()
  | ATSfunclo_clo of ()
//
  | ATSINSlab of ()
  | ATSINSgoto of ()
//
  | ATSINSflab of ()
  | ATSINSfgoto of ()
//
  | ATSINSfreeclo of ()
  | ATSINSfreecon of ()
//
  | ATSINSmove of ()
  | ATSINSmove_void of ()
//
  | ATSINSmove_nil of ()
  | ATSINSmove_con0 of ()
  | ATSINSmove_con1_beg of ()
  | ATSINSmove_con1_end of ()
  | ATSINSmove_con1_new of ()
  | ATSINSstore_con1_tag of ()
  | ATSINSstore_con1_ofs of ()
//
  | ATSINSmove_boxrec_beg of ()
  | ATSINSmove_boxrec_end of ()
  | ATSINSmove_boxrec_new of ()
  | ATSINSstore_boxrec_ofs of ()
//
  | ATSINSmove_fltrec_beg of ()
  | ATSINSmove_fltrec_end of ()
  | ATSINSstore_fltrec_ofs of ()
//
  | ATSINSmove_delay of ()
  | ATSINSmove_lazyeval of ()
//
  | ATStailcal_beg of ()
  | ATStailcal_end of ()
  | ATSINSmove_tlcal of ()
  | ATSINSargmove_tlcal of ()
//
  | ATSINSextvar_assign of ()
  | ATSINSdyncst_valbind of ()
//
  | ATSINScaseof_fail of ()
  | ATSINSdeadcode_fail of ()
//
  | ATSdynload of ()
  | ATSdynloadset of ()
  | ATSdynloadfcall of ()
  | ATSdynloadflag_sta of ()
  | ATSdynloadflag_ext of ()
  | ATSdynloadflag_init of ()
  | ATSdynloadflag_minit of ()
//
  | ATSclosurerize_beg of ()
  | ATSclosurerize_end of ()
//
  | KWORDnone of () // for indicating a non-keyword
//
// end of [keyword]

(* ****** ****** *)
//
fun print_keyword : (keyword) -> void
fun prerr_keyword : (keyword) -> void
fun fprint_keyword: fprint_type (keyword)
//
overload print with print_keyword
overload prerr with prerr_keyword
overload fprint with fprint_keyword
//
(* ****** ****** *)

fun keyword_search (name: string): keyword

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

datatype
token_node =
//
| T_KWORD of keyword
//
| T_IDENT_alp of string
| T_IDENT_sym of string
| T_IDENT_srp of string
//
| T_CHAR of (string)
//
| T_INT of (int(*base*), string)
| T_FLOAT of (int(*base*), string)
//
| T_STRING of (string)
//
| T_LPAREN of () // (
| T_RPAREN of () // )
| T_LBRACKET of () // [
| T_RBRACKET of () // ]
| T_LBRACE of () // {
| T_RBRACE of () // }
//
| T_LT of ()
| T_GT of ()
//
| T_MINUS of ()
//
| T_COLON of () // :
//
| T_COMMA of () // ,
| T_SEMICOLON of () // ;
//
| T_SLASH of () // /
//
| T_ENDL of ()
| T_SPACES of (string)
//
| T_COMMENT_line of (string) // line comment
| T_COMMENT_block of (string) // block comment
//
| T_EOF of () // end-of-file
//
// end of [token_node]

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

typedef tnode = token_node

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

typedef token = '{
  token_loc= loc_t, token_node= tnode
} (* end of [token] *)

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

typedef tokenlst = List0 (token)
typedef tokenopt = Option (token)

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

fun token_get_loc (token): loc_t

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

fun fprint_tnode : fprint_type (tnode)

(* ****** ****** *)
//
fun print_token : (token) -> void
fun prerr_token : (token) -> void
fun fprint_token : fprint_type (token)
//
overload print with print_token
overload prerr with prerr_token
overload fprint with fprint_token
//
(* ****** ****** *)
//
fun
token_make (loc: loc_t, node: tnode): token
//
(* ****** ****** *)

typedef i0nt = token
typedef f0loat = token
typedef s0tring = token

(* ****** ****** *)
//
datatype
lexerr_node =
  | LEXERR_FEXPONENT_nil of ()
  | LEXERR_UNSUPPORTED_char of (char)
//
typedef lexerr = '{
  lexerr_loc= loc_t, lexerr_node= lexerr_node
} (* end of [lexerr] *)
//
typedef lexerrlst = List0 (lexerr)
//
(* ****** ****** *)
//
fun print_lexerr (lexerr): void
fun prerr_lexerr (lexerr): void
//
fun fprint_lexerr : fprint_type (lexerr)
fun fprint_lexerrlst : fprint_type (lexerrlst)
//
overload print with print_lexerr
overload prerr with prerr_lexerr
overload fprint with fprint_lexerr
//
(* ****** ****** *)
//
fun
lexerr_make
  (loc: loc_t, node: lexerr_node): lexerr
//
(* ****** ****** *)
//
fun the_lexerrlst_clear (): void
//
fun the_lexerrlst_insert (err: lexerr): void
//
fun the_lexerrlst_pop_all ((*void*)): List0_vt(lexerr)
//
fun the_lexerrlst_print_free ((*void*)): int(*nerr*)
//
(* ****** ****** *)
//
vtypedef
_lexbuf_vt0ype =
@{
//
lexbuf_ntot= int
,
lexbuf_nrow= int
,
lexbuf_ncol= int
,
//
lexbuf_nspace= int
//
,
//
lexbuf_cstream= cstream
//
,
lexbuf_nback= int
,
lexbuf_stringbuf= stringbuf
//
} // end of [_lexbuf_vt0ype]

(* ****** ****** *)
//
absvt@ype
lexbuf_vt0ype = _lexbuf_vt0ype
//
vtypedef lexbuf = lexbuf_vt0ype
//
(* ****** ****** *)
//
fun
lexbuf_initize_string
  (buf: &lexbuf? >> _, inp: string): void
fun
lexbuf_initize_fileref
  (buf: &lexbuf? >> _, inp: FILEref): void
//
(* ****** ****** *)

fun lexbuf_uninitize (buf: &lexbuf >> _?): void

(* ****** ****** *)
//
fun
lexbuf_set_position
  (buf: &lexbuf >> _, pos: &position): void
fun
lexbuf_get_position
  (buf: &lexbuf, pos: &position? >> _): void
//
(* ****** ****** *)

fun lexbuf_set_nback (buf: &lexbuf, nb: int): void
fun lexbuf_incby_nback (buf: &lexbuf, nb: int): void

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

fun lexbuf_get_nspace (buf: &lexbuf): int
fun lexbuf_set_nspace (buf: &lexbuf, n: int): void

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

fun lexbuf_remove
  (buf: &lexbuf >> _, nchr: intGte(0)): void

fun lexbuf_remove_all (buf: &lexbuf >> _): void

(* ****** ****** *)
//
fun lexbuf_takeout
  (buf: &lexbuf >> _, nchr: intGte(0)): Strptr1
//
(* ****** ****** *)

fun lexbuf_get_char (buf: &lexbuf >> _): int

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

fun lexbuf_get_token_any (buf: &lexbuf >> _): token
fun lexbuf_get_token_skip (buf: &lexbuf >> _): token

(* ****** ****** *)
//
fun lexbufpos_get_location (buf: &lexbuf, pos: &position) : loc_t
//
fun lexbuf_getbyrow_location (buf: &lexbuf): loc_t
fun lexbuf_getincby_location (buf: &lexbuf, nchr: intGte(0)): loc_t
//
(* ****** ****** *)

vtypedef
_tokbuf_vt0ype =
@{
//
  tokbuf_tkbf = dynarray (token)
, tokbuf_ntok= size_t, tokbuf_lxbf= lexbuf
//
} (* end of [_tokbuf_vt0ype] *)

(* ****** ****** *)
//
absvt@ype
tokbuf_vt0ype = _tokbuf_vt0ype
//
vtypedef tokbuf = tokbuf_vt0ype
//
(* ****** ****** *)
//
fun
tokbuf_initize_string
  (buf: &tokbuf? >> _, inp: string): void
fun
tokbuf_initize_fileref
  (buf: &tokbuf? >> _, inp: FILEref): void
//
(* ****** ****** *)

fun tokbuf_reset (buf: &tokbuf >> _): void

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

fun tokbuf_uninitize (buf: &tokbuf >> _?): void

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

fun
tokbuf_get_ntok (buf: &tokbuf >> _): size_t
fun
tokbuf_set_ntok (buf: &tokbuf >> _, ntok: size_t): void

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

fun
tokbuf_incby1 (buf: &tokbuf >> _): void
fun
tokbuf_incby_count (buf: &tokbuf >> _, n: size_t): void

(* ****** ****** *)
//
fun
tokbuf_get_token (buf: &tokbuf >> _): token
fun
tokbuf_get_token_any (buf: &tokbuf >> _): token
//
fun
tokbuf_getinc_token (buf: &tokbuf >> _): token
//
(* ****** ****** *)

fun
tokbuf_get_location (buf: &tokbuf >> _): loc_t

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

abstype symbol_type = ptr
typedef symbol = symbol_type

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

fun symbol_make (name: string): symbol

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

fun symbol_get_name (x: symbol):<> string

(* ****** ****** *)
//
fun print_symbol : (symbol) -> void
fun prerr_symbol : (symbol) -> void
fun fprint_symbol : fprint_type (symbol)
//
overload print with print_symbol
overload prerr with prerr_symbol
overload fprint with fprint_symbol
//
(* ****** ****** *)
//
fun eq_symbol_symbol
  : (symbol, symbol) -<0> bool
//
overload = with eq_symbol_symbol
//
(* ****** ****** *)
//
abstype synent_type = ptr
typedef synent = synent_type
//
(* ****** ****** *)
//
datatype
signed = SIGNED of (loc_t, int)
//
(* ****** ****** *)

typedef
i0de = '{
  i0dex_loc= loc_t, i0dex_sym= symbol
} (* end of [i0de] *)

(* ****** ****** *)
//
fun print_i0de : i0de -> void
fun prerr_i0de : i0de -> void
fun fprint_i0de : fprint_type (i0de)
//
overload print with print_i0de
overload prerr with prerr_i0de
overload fprint with fprint_i0de
//
(* ****** ****** *)

typedef label = i0de
typedef labelist = List0 (label)
vtypedef labelist_vt = List0_vt (label)

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

datatype
s0exp_node =
  | S0Eide of symbol
  | S0Elist of (s0explst) // temp
  | S0Eappid of (i0de, s0explst)
// end of [s0exp_node]

where
s0exp = '{
  s0exp_loc= loc_t, s0exp_node= s0exp_node
} (* end of [s0exp] *)

and s0explst = List0 (s0exp)
and s0expopt = Option (s0exp)

(* ****** ****** *)
//
fun print_s0exp : s0exp -> void
fun prerr_s0exp : s0exp -> void
fun fprint_s0exp : fprint_type (s0exp)
fun fprint_s0explst : fprint_type (s0explst)
//
overload print with print_s0exp
overload prerr with prerr_s0exp
overload fprint with fprint_s0exp
overload fprint with fprint_s0explst of 10
//
(* ****** ****** *)
//
datatype
tyfld_node =
TYFLD of (i0de, s0exp)
typedef
tyfld = '{
  tyfld_loc= loc_t
, tyfld_node= tyfld_node
} (* end of [tyfld] *)
//
typedef tyfldlst = List0 (tyfld)
//
typedef tyrec = '{
  tyrec_loc= loc_t, tyrec_node= tyfldlst
} (* end of [tyrec] *)
//
(* ****** ****** *)

datatype
d0exp_node =
  | D0Eide of (i0de)
  | D0Elist of (d0explst) // temp
  | D0Eappid of (i0de, d0explst)
  | D0Eappexp of (d0exp, d0explst)
//
  | ATSPMVint of i0nt
  | ATSPMVintrep of i0nt
  | ATSPMVbool of bool
  | ATSPMVfloat of f0loat
  | ATSPMVstring of s0tring
//
  | ATSPMVi0nt of i0nt
  | ATSPMVf0loat of f0loat
//
  | ATSPMVempty of (int) // void-value
  | ATSPMVextval of (tokenlst) // external values
//
  | ATSPMVrefarg0 of (d0exp)
  | ATSPMVrefarg1 of (d0exp)
//
  | ATSPMVfunlab of (label)
  | ATSPMVcfunlab of (int(*knd*), label, d0explst)
//
  | ATSPMVcastfn of (i0de(*fun*), s0exp, d0exp(*arg*))
//
  | ATSCSTSPmyloc of s0tring
//
  | ATSCKiseqz of (d0exp)
  | ATSCKisneqz of (d0exp)
  | ATSCKptriscons of (d0exp)
  | ATSCKptrisnull of (d0exp)
//
  | ATSCKpat_int of (d0exp, d0exp)
  | ATSCKpat_bool of (d0exp, d0exp)
  | ATSCKpat_string of (d0exp, d0exp)
//
  | ATSCKpat_con0 of (d0exp, int(*tag*))
  | ATSCKpat_con1 of (d0exp, int(*tag*))
//
  | ATSSELcon of (d0exp, s0exp(*tysum*), i0de(*lab*))
  | ATSSELrecsin of (d0exp, s0exp(*tyrec*), i0de(*lab*))
  | ATSSELboxrec of (d0exp, s0exp(*tyrec*), i0de(*lab*))
  | ATSSELfltrec of (d0exp, s0exp(*tyrec*), i0de(*lab*))
//
  | ATSextfcall of
      (i0de(*fun*), d0explst(*arg*))
    // end of [ATSextfcall]
  | ATSextmcall of
      (d0exp(*obj*), d0exp(*method*), d0explst(*arg*))
    // end of [ATSextmcall]
//
  | ATSfunclo_fun of (d0exp, s0exp(*arg*), s0exp(*res*))
  | ATSfunclo_clo of (d0exp, s0exp(*arg*), s0exp(*res*))
//
// end of [d0exp_node]

where
d0exp = '{
  d0exp_loc= loc_t, d0exp_node= d0exp_node
} (* end of [d0exp] *)

and d0explst = List0 (d0exp)
and d0expopt = Option (d0exp)

(* ****** ****** *)
//
fun print_d0exp : d0exp -> void
fun prerr_d0exp : d0exp -> void
fun fprint_d0exp : fprint_type (d0exp)
fun fprint_d0explst : fprint_type (d0explst)
//
overload print with print_d0exp
overload prerr with prerr_d0exp
overload fprint with fprint_d0exp
overload fprint with fprint_d0explst of 10
//
(* ****** ****** *)

datatype
f0arg_node =
  | F0ARGnone of (s0exp)
  | F0ARGsome of (i0de, s0exp)
// end of [f0arg_node]

typedef
f0arg = '{
  f0arg_loc= loc_t, f0arg_node= f0arg_node
} (* end of [f0arg] *)

typedef f0arglst = List0 (f0arg)

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

typedef
f0marg = '{
  f0marg_loc= loc_t, f0marg_node= f0arglst
} (* end of [f0marg] *)

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

datatype
fkind_node =
  | FKextern of () | FKstatic of ()
// end of [fkind_node]

typedef fkind = '{
  fkind_loc= loc_t, fkind_node= fkind_node
} (* end of [fkind] *)

(* ****** ****** *)
//
datatype
f0head_node =
F0HEAD of (i0de, f0marg, s0exp)
//
typedef
f0head = '{
  f0head_loc= loc_t, f0head_node= f0head_node
} (* end of [f0head] *)
//
(* ****** ****** *)

typedef f0headopt = Option (f0head)

(* ****** ****** *)
//
fun fprint_f0arg : fprint_type (f0arg)
fun fprint_f0marg : fprint_type (f0marg)
fun fprint_fkind : fprint_type (fkind)
fun fprint_f0head : fprint_type (f0head)
//
overload fprint with fprint_f0arg
overload fprint with fprint_f0marg
overload fprint with fprint_fkind
overload fprint with fprint_f0head
//
(* ****** ****** *)
//
fun
f0marg_isneqz (f0ma: f0marg): bool
//
overload isneqz with f0marg_isneqz
//
(* ****** ****** *)
//
datatype
tmpdec_node =
| TMPDECnone of (i0de)
| TMPDECsome of (i0de, s0exp)
//
typedef
tmpdec = '{
  tmpdec_loc= loc_t, tmpdec_node= tmpdec_node
} (* end of [tmpdec] *)
//
typedef tmpdeclst = List0 (tmpdec)
//
(* ****** ****** *)
//
fun fprint_tmpdec: fprint_type(tmpdec)
fun fprint_tmpdeclst: fprint_type(tmpdeclst)
//
overload fprint with fprint_tmpdec
overload fprint with fprint_tmpdeclst
//
(* ****** ****** *)
//
datatype
instr_node =
//
  | ATSif of (
      d0exp // HX: cond
    , instrlst // HX: then
    , instrlstopt // HX: else
    ) (* end of [ATSif] *)
//
  | ATSthen of instrlst // temp
  | ATSelse of instrlst // temp
//
  | ATSifthen of (d0exp, instrlst)
  | ATSifnthen of (d0exp, instrlst)
//
  | ATSbranchseq of (instrlst)
  | ATScaseofseq of (instrlst(*branches*))
//
  | ATSfunbodyseq of instrlst
//
  | ATSreturn of (i0de)
  | ATSreturn_void of (i0de)
//
  | ATSlinepragma of (token(*line*), token(*file*))
//
  | ATSINSlab of (label)
  | ATSINSgoto of (label)
//
  | ATSINSflab of (label)
  | ATSINSfgoto of (label)
//
  | ATSINSfreeclo of (d0exp)
  | ATSINSfreecon of (d0exp)
//
  | ATSINSmove of (i0de, d0exp)
  | ATSINSmove_void of (i0de, d0exp)
//
  | ATSINSmove_nil of (i0de)
  | ATSINSmove_con0 of (i0de, token(*tag*))
//
  | ATSINSmove_con1 of (instrlst)
  | ATSINSmove_con1_new of (i0de, s0exp)
  | ATSINSstore_con1_tag of (i0de, token(*tag*))
  | ATSINSstore_con1_ofs of (i0de, s0exp, i0de, d0exp)
//
  | ATSINSmove_boxrec of (instrlst)
  | ATSINSmove_boxrec_new of (i0de, s0exp)
  | ATSINSstore_boxrec_ofs of (i0de, s0exp, i0de, d0exp)
//
  | ATSINSmove_fltrec of (instrlst)
  | ATSINSstore_fltrec_ofs of (i0de, s0exp, i0de, d0exp)
//
  | ATSINSmove_delay of (i0de, s0exp, d0exp)
  | ATSINSmove_lazyeval of (i0de, s0exp, d0exp)
//
  | ATStailcalseq of instrlst
  | ATSINSmove_tlcal of (i0de, d0exp)
  | ATSINSargmove_tlcal of (i0de, i0de)
//
  | ATSINSextvar_assign of (d0exp, d0exp)
  | ATSINSdyncst_valbind of (i0de, d0exp)
//
  | ATSINScaseof_fail of (token)
  | ATSINSdeadcode_fail of (token)
//
  | ATSdynload of int
  | ATSdynloadset of (i0de)
  | ATSdynloadfcall of (i0de)
  | ATSdynloadflag_sta of (i0de)
  | ATSdynloadflag_ext of (i0de)
  | ATSdynloadflag_init of (i0de)
  | ATSdynloadflag_minit of (i0de)
//
// end of [instr_node]
//
where
instr = '{
  instr_loc= loc_t, instr_node= instr_node
} (* end of [instr] *)
//
and instrlst = List0 (instr)
and instropt = Option (instr)
and instrlstopt = Option (instrlst)
//
vtypedef
instrlst_vt = List0_vt (instr)
//
(* ****** ****** *)
//
fun fprint_instr : fprint_type (instr)
fun fprint_instrlst : fprint_type (instrlst)
//
overload fprint with fprint_instr
overload fprint with fprint_instrlst of 10
//
(* ****** ****** *)

datatype
f0body_node =
F0BODY of (tmpdeclst, instrlst)
//
typedef f0body = '{
  f0body_loc= loc_t, f0body_node= f0body_node
} (* end of [f0body] *)

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

datatype
f0decl_node =
  | F0DECLnone of (f0head)
  | F0DECLsome of (f0head, f0body)
// end of [f0decl_node]

typedef
f0decl = '{
  f0decl_loc= loc_t, f0decl_node= f0decl_node
} (* end of [f0decl] *)

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

fun
fprint_f0decl:fprint_type (f0decl)
overload fprint with fprint_f0decl

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

datatype
d0ecl_node =
//
  | D0Cinclude of s0tring
//
  | D0Cifdef of (i0de, d0eclist)
  | D0Cifndef of (i0de, d0eclist)
//
  | D0Ctypedef of (i0de, tyrec)
//
  | D0Cassume of i0de // HX: assume ...
//
  | D0Cdyncst_mac of i0de
//
  | D0Cdyncst_extfun of (i0de, s0explst, s0exp)
//
  | D0Cdyncst_valdec of (i0de, s0exp)
  | D0Cdyncst_valimp of (i0de, s0exp)
//
  | D0Cextcode of (tokenlst)
//
  | D0Cstatmp of (i0de, s0expopt)
//
  | D0Cfundecl of (fkind, f0decl)
//
  | D0Cclosurerize of (
      i0de, s0exp(*env*), s0exp(*arg*), s0exp(*res*)
    ) (* end of [D0Cclosurerize] *)
//
  | D0Cdynloadflag_init of (i0de)
  | D0Cdynloadflag_minit of (i0de)
//
// end of [d0ecl_node]

where
d0ecl = '{
//
d0ecl_loc= loc_t, d0ecl_node= d0ecl_node
//
} (* end of [d0ecl] *)

and
d0eclist = List0 (d0ecl)

(* ****** ****** *)
//
fun fprint_d0ecl : fprint_type (d0ecl)
fun fprint_d0eclist : fprint_type (d0eclist)
//
overload fprint with fprint_d0ecl
overload fprint with fprint_d0eclist of 10
//
(* ****** ****** *)

(* end of [catsparse.sats] *)


Updating: adding a tail-recursive implementation for P2

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

(* ****** ****** *)
//
// HX-2015-02-01:
// Please note that
// the solution is
// verified and tail-recursive
//
(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTcom
// Start time: February 1, 2015
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
staload
"{$LIBATSHWXI}/PEULER/SATS/peuler.sats"
//
(* ****** ****** *)
//
staload
"{$LIBATSHWXI}/PEULER/PROJECT/P2/P2.sats"
//
(* ****** ****** *)
//
dataprop
FIB_(int(*n*), int(*r*)) =
| FIB_rule0 (0, 0)
| FIB_rule1 (1, 1)
| {n:nat}{r0,r1:int}
  FIB_rule2 (n+2, r0+r1) of (FIB_(n, r0), FIB_(n+1, r1))
//
(* ****** ****** *)

assume FIB(n:int, r:int) = FIB_(n, r)

(* ****** ****** *)
//
extern
praxi
FIB_isfun{n:nat}{r1,r2:int}
  (FIB(n, r1), FIB(n, r2)): [r1==r2] void
//
extern
praxi
MYSUM_istot{n:pos}(): [t:int] MYSUM(n, t)
//
(* ****** ****** *)
//
extern
praxi
MYSUM_un_rule0
  {n:nat}
  {r:int | r > LIMIT}
  {t:int}(pf1: FIB(n, r), pf2: MYSUM(n, t)): [t==0] void
//
extern
praxi
MYSUM_un_rule1
  {n:nat}
  {r:int | r <= LIMIT; r mod 2 > 0}
  {t:int}(pf1: FIB(n, r), pf2: MYSUM(n, t)): MYSUM(n+1, t)
extern
praxi
MYSUM_un_rule2
  {n:nat}
  {r:int | r <= LIMIT; r mod 2 == 0}
  {t:int}(pf1: FIB(n, r), pf2: MYSUM(n, t)): MYSUM(n+1, t-r)
//
(* ****** ****** *)

implement
mysum((*void*)) = let
//
prval
[t0:int]
pfres = MYSUM_istot{1}()
//
fun
loop
{n:pos}
{r0,r1:nat}
{res:int}
(
  pf0: FIB(n, r0)
, pf1: FIB(n-1, r1)
, pf2: MYSUM(n, t0-res)
| n: int(n), r0: int(r0), r1: int(r1), res: int(res)
) : int(t0) =
(
if
r0 > LIMIT
then let
  prval () = MYSUM_un_rule0 (pf0, pf2) in res
end // end of [then]
else let
  val k0 = r0-2*half(r0)
in
  if k0 > 0
    then let
      prval pf2 = MYSUM_un_rule1 (pf0, pf2)
    in
      loop (FIB_rule2(pf1, pf0), pf0, pf2 | n+1, r0+r1, r0, res)
    end // end of [then]
    else let
      prval pf2 = MYSUM_un_rule2 (pf0, pf2)
    in
      loop (FIB_rule2(pf1, pf0), pf0, pf2 | n+1, r0+r1, r0, res+r0)
    end // end of [else]
  // end of [if]
end // end of [else]
)
//
in
  (pfres | loop (FIB_rule1(), FIB_rule0(), pfres | 1, 1, 0, 0))
end // end of [mysum]

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

implement
main0 () =
{
//
val (pf | ans) = mysum()
val () =
(
  println! ("The sum of all the even fibs < ", LIMIT, " equals ", ans)
) (* end of [val] *)
} (* end of [main0] *)

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

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

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

(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTcom
// Start time: February 1, 2015
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
staload
"{$LIBATSHWXI}/PEULER/SATS/peuler.sats"
//
(* ****** ****** *)
//
staload
"{$LIBATSHWXI}/PEULER/PROJECT/P2/P2.sats"
//
(* ****** ****** *)
//
dataprop
FIB_(int(*n*), int(*r*)) =
| FIB_rule0 (0, 0)
| FIB_rule1 (1, 1)
| {n:nat}{r0,r1:int}
  FIB_rule2 (n+2, r0+r1) of (FIB_(n, r0), FIB_(n+1, r1))
//
(* ****** ****** *)

assume FIB(n:int, r:int) = FIB_(n, r)

(* ****** ****** *)
//
extern
praxi
FIB_isfun{n:nat}{r1,r2:int}
  (FIB(n, r1), FIB(n, r2)): [r1==r2] void
//
extern
praxi
MYSUM_istot{n:pos}(): [t:int] MYSUM(n, t)
//
(* ****** ****** *)
//
extern
praxi
MYSUM_un_rule0
  {n:nat}
  {r:int | r > LIMIT}
  {t:int}(pf1: FIB(n, r), pf2: MYSUM(n, t)): [t==0] void
//
extern
praxi
MYSUM_un_rule1
  {n:nat}
  {r:int | r <= LIMIT; r mod 2 > 0}
  {t:int}(pf1: FIB(n, r), pf2: MYSUM(n, t)): MYSUM(n+1, t)
extern
praxi
MYSUM_un_rule2
  {n:nat}
  {r:int | r <= LIMIT; r mod 2 == 0}
  {t:int}(pf1: FIB(n, r), pf2: MYSUM(n, t)): MYSUM(n+1, t-r)
//
(* ****** ****** *)

implement
mysum((*void*)) = let
//
prval
[t0:int]
pfres = MYSUM_istot{1}()
//
fun
loop
{n:pos}
{r0,r1:nat}
{res:int}
(
  pf0: FIB(n, r0)
, pf1: FIB(n-1, r1)
, pf2: MYSUM(n, t0-res)
| n: int(n), r0: int(r0), r1: int(r1), res: int(res)
) : int(t0) =
(
if
r0 > LIMIT
then let
  prval () = MYSUM_un_rule0 (pf0, pf2) in res
end // end of [then]
else let
  val k0 = r0-2*half(r0)
in
  if k0 > 0
    then let
      prval pf2 = MYSUM_un_rule1 (pf0, pf2)
    in
      loop (FIB_rule2(pf1, pf0), pf0, pf2 | n+1, r0+r1, r0, res)
    end // end of [then]
    else let
      prval pf2 = MYSUM_un_rule2 (pf0, pf2)
    in
      loop (FIB_rule2(pf1, pf0), pf0, pf2 | n+1, r0+r1, r0, res+r0)
    end // end of [else]
  // end of [if]
end // end of [else]
)
//
in
  (pfres | loop (FIB_rule1(), FIB_rule0(), pfres | 1, 1, 0, 0))
end // end of [mysum]

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

implement
main0 () =
{
//
val (pf | ans) = mysum()
val () =
(
  println! ("The sum of all the even fibs < ", LIMIT, " equals ", ans)
) (* end of [val] *)
} (* end of [main0] *)

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

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


Add _read function for w5100

Add _read function for w5100

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

#define ATS_DYNLOADFLAG 0 // no dynloading at run-time
#include "config.hats"
#include "{$TOP}/avr_prelude/kernel_staload.hats"

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

macdef DDRB_PTR  = $extval(ptr, "(&DDRB)")
macdef PORTB_PTR  = $extval(ptr, "(&PORTB)")

extern fun initSS (): void = "mac#"
extern fun setSS (): void = "mac#"
extern fun resetSS (): void = "mac#"

fun _write (addr: uint16, data: uint8): void = {
  val () = setSS ()
  val _ = spi_transfer ($UN.cast 0xf0)
  val _ = spi_transfer ($UN.cast (addr >> 8))
  val v = g0uint_land_uint16 (addr, ($UN.cast 0xff))
  val _ = spi_transfer ($UN.cast v)
  val _ = spi_transfer data
  val () = resetSS ()
}

fun _read (addr: uint16): uint8 = r where {
  val () = setSS ()
  val _ = spi_transfer ($UN.cast 0xf0)
  val _ = spi_transfer ($UN.cast (addr >> 8))
  val v = g0uint_land_uint16 (addr, ($UN.cast 0xff))
  val _ = spi_transfer ($UN.cast v)
  val r = spi_transfer ($UN.cast 0)
  val () = resetSS ()
}

implement ethernet_w5100_init () = {
  val () = delay_ms 300.0
  val () = spi_begin ()
  val () = initSS ()
  // xxx
}

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

#define ATS_DYNLOADFLAG 0 // no dynloading at run-time
#include "config.hats"
#include "{$TOP}/avr_prelude/kernel_staload.hats"

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

macdef DDRB_PTR  = $extval(ptr, "(&DDRB)")
macdef PORTB_PTR  = $extval(ptr, "(&PORTB)")

extern fun initSS (): void = "mac#"
extern fun setSS (): void = "mac#"
extern fun resetSS (): void = "mac#"

fun _write (addr: uint16, data: uint8): void = {
  val () = setSS ()
  val _ = spi_transfer ($UN.cast 0xf0)
  val _ = spi_transfer ($UN.cast (addr >> 8))
  val v = g0uint_land_uint16 (addr, ($UN.cast 0xff))
  val _ = spi_transfer ($UN.cast v)
  val _ = spi_transfer data
  val () = resetSS ()
}

implement ethernet_w5100_init () = {
  val () = delay_ms 300.0
  val () = spi_begin ()
  val () = initSS ()
  // xxx
}


Updating: very minorly

Updating: very minorly

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

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

#define ATS_DYNLOADFLAG 0

(* ****** ****** *)
//
// HX-2014-08:
// prefix for external names
//
#define
ATS_EXTERN_PREFIX "ats2pypre_"
#define
ATS_STATIC_PREFIX "_ats2pypre_matrixref_"
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
staload "./../basics_py.sats"
//
staload "./../SATS/integer.sats"
//
(* ****** ****** *)
//
staload "./../SATS/PYlist.sats"
staload "./../SATS/intrange.sats"
//
(* ****** ****** *)
//
staload "./../SATS/matrixref.sats"
//
(* ****** ****** *)
//
#include "{$LIBATSCC}/DATS/matrixref.dats"
//
(* ****** ****** *)
//
(*
assume
matrixref_vt0ype_type(a, n) = PYlist(a)
*)
//
(* ****** ****** *)

%{^
######
def ats2pypre_matrixref_make_elt(m, n, x0):
  M = []
  i0 = 0
  mn = m * n
  while (i0 < mn): i0 = i0 + 1; M.append(x0)
  return M
######
%} // end of [%{^]

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

implement
matrixref_get_at
  {a}(A, i, n, j) = let
  val A = $UN.cast{PYlist(a)}(A) in PYlist_get_at(A, i*n+j)
end // end of [matrixref_get_at]

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

implement
matrixref_set_at
  {a}(A, i, n, j, x) = let
  val A = $UN.cast{PYlist(a)}(A) in PYlist_set_at(A, i*n+j, x)
end // end of [matrixref_set_at]

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

%{^
######
def ats2pypre_mtrxszref_make_matrixref(M, m, n):
  return { 'matrix' : M, 'nrow' : m, 'ncol' : n }
######
def ats2pypre_mtrxszref_get_nrow(MSZ): return MSZ['nrow']
def ats2pypre_mtrxszref_get_ncol(MSZ): return MSZ['ncol']
######
def ats2pypre_mtrxszref_get_at(MSZ, i, j):
  nrow = MSZ['nrow']
  ncol = MSZ['ncol']
  if (i < 0):
    raise IndexError('mtrxszref_get_at')
  if (j < 0):
    raise IndexError('mtrxszref_get_at')
  if (i >= nrow):
    raise IndexError('mtrxszref_get_at')
  if (j >= ncol):
    raise IndexError('mtrxszref_get_at')
  return MSZ['matrix'][i*ncol+j]
######
def ats2pypre_mtrxszref_set_at(MSZ, i, j, x0):
  nrow = MSZ['nrow']
  ncol = MSZ['ncol']
  if (i < 0):
    raise IndexError('mtrxszref_set_at')
  if (j < 0):
    raise IndexError('mtrxszref_set_at')
  if (i >= nrow):
    raise IndexError('mtrxszref_set_at')
  if (j >= ncol):
    raise IndexError('mtrxszref_set_at')
  MSZ['matrix'][i*ncol+j] = x0; return#_void
######
%} // end of [%{^]

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

(* end of [matrixref.dats] *)

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

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

#define ATS_DYNLOADFLAG 0

(* ****** ****** *)
//
// HX-2014-08:
// prefix for external names
//
#define
ATS_EXTERN_PREFIX "ats2pypre_"
#define
ATS_STATIC_PREFIX "_ats2pypre_matrixref_"
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
staload "./../basics_py.sats"
//
staload "./../SATS/integer.sats"
//
(* ****** ****** *)
//
staload "./../SATS/PYlist.sats"
staload "./../SATS/intrange.sats"
//
(* ****** ****** *)
//
staload "./../SATS/matrixref.sats"
//
(* ****** ****** *)
//
#include "{$LIBATSCC}/DATS/matrixref.dats"
//
(* ****** ****** *)
//
(*
assume
matrixref_vt0ype_type(a, n) = PYlist(a)
*)
//
(* ****** ****** *)

implement
matrixref_get_at
  {a}(A, i, n, j) = let
  val A = $UN.cast{PYlist(a)}(A) in PYlist_get_at(A, i*n+j)
end // end of [matrixref_get_at]

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

implement
matrixref_set_at
  {a}(A, i, n, j, x) = let
  val A = $UN.cast{PYlist(a)}(A) in PYlist_set_at(A, i*n+j, x)
end // end of [matrixref_set_at]

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

%{^
######
def ats2pypre_mtrxszref_make_matrixref(M, m, n):
  return { 'matrix' : M, 'nrow' : m, 'ncol' : n }
######
def ats2pypre_mtrxszref_get_nrow(MSZ): return MSZ['nrow']
def ats2pypre_mtrxszref_get_ncol(MSZ): return MSZ['ncol']
######
def ats2pypre_mtrxszref_get_at(MSZ, i, j):
  nrow = MSZ['nrow']
  ncol = MSZ['ncol']
  if (i < 0):
    raise IndexError('mtrxszref_get_at')
  if (j < 0):
    raise IndexError('mtrxszref_get_at')
  if (i >= nrow):
    raise IndexError('mtrxszref_get_at')
  if (j >= ncol):
    raise IndexError('mtrxszref_get_at')
  return MSZ['matrix'][i*ncol+j]
######
def ats2pypre_mtrxszref_set_at(MSZ, i, j, x0):
  nrow = MSZ['nrow']
  ncol = MSZ['ncol']
  if (i < 0):
    raise IndexError('mtrxszref_set_at')
  if (j < 0):
    raise IndexError('mtrxszref_set_at')
  if (i >= nrow):
    raise IndexError('mtrxszref_set_at')
  if (j >= ncol):
    raise IndexError('mtrxszref_set_at')
  MSZ['matrix'][i*ncol+j] = x0; return#_void
######
%} // end of [%{^]

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

(* end of [matrixref.dats] *)


Updating: very minorly tidying-up

Updating: very minorly tidying-up

(*
#
# ListMergeSort
#
*)
(* ****** ****** *)

#define ATS_DYNLOADFLAG 0

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

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

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

staload _ = "prelude/DATS/list.dats"
staload _ = "prelude/DATS/list_vt.dats"

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

%{^
typedef char *charptr;
%} // end of [%{^]
abstype charptr = $extype"charptr"

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

%{^
#define ATS_MFREE free
#define ATS_MALLOC malloc
#define ATSextmcall(obj, mtd, funarg) obj.mtd funarg
%} // end of [%{^]

(* ****** ****** *)
//
%{^
void *theList = 0;
void *theList_get ()
{
  void *res;
  res = theList;
  theList = NULL;
  return res;
} /* end of [theList_get] */
%} // end of [%{^]
//
extern
fun
theList_get(): List0_vt(int) = "mac#"
//
(* ****** ****** *)

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)
//
fun
from
(
  m: int, n: int
) : List0_vt(int) =
(
if m < n
  then cons_vt (m, from(m+1, n)) else nil_vt ()
// end of [if]
) (* end of [from] *)
//
extvar "theList" = from(0, 10)
//
} (* end of [setup] *)
//
(* ****** ****** *)
//
implement
fprint_val<int>
  (out, x) =
  $extmcall(void, Serial, "print", x)
//
(* ****** ****** *)
//
(*
implement
fprint_string (out, x) = Serial_ptr.print(x)
*)
(* ****** ****** *)
//
implement
fprint_list_vt$sep<> (out) = ()
//
(* ****** ****** *)

staload MS = "./list_vt_mergesort.dats"

(* ****** ****** *)
//
extern
fun
loop (): void = "mac#"
//
implement
loop () =
myloop(0) where
{
//
fun
mysort{n:int}
(
  xs: list_vt(int, n)
) : list_vt(int, n) = let
//
implement
$MS.list_vt_mergesort$cmp<int>
  (x1, x2, n1, n2) = compare (x1, x2)
//
in
  list_vt_mergesort (xs)
end // end of [mysort]
//
fun
myrand{n:int}
(
  xs: list_vt(int, n)
) : list_vt(int, n) = let
//
implement
$MS.list_vt_mergesort$cmp<int>
  (x1, x2, n1, n2) =
(
  $effmask_all(if random(n1+n2) < n1 then 0 else 1)
)
//
in
  list_vt_mergesort (xs)
end // end of [myrand]
//
fun
myloop
(
  bit: int
) : void = let
//
val
out = $extval (FILEref, "0")
//
(*
val () = randomSeed($UN.cast{uint}(millis()))
*)
//
val xs = theList_get()
val () = fprint_list_vt (out, xs)
val () = Serial_ptr.println()
extvar "theList" =
  (if bit = 0 then myrand(xs) else mysort(xs)): List0_vt(int)
//
val () = digitalWrite(LEDPIN, 1)
val () = delay(250)
val () = digitalWrite(LEDPIN, 0)
val () = delay(1000)
//
in
  myloop (1-bit)
end // end of [myloop]
//
} (* end of [loop] *)
//
(* ****** ****** *)

(* end of [ListMergeSort.dats] *)

(*
#
# ListMergeSort
#
*)
(* ****** ****** *)

#define ATS_DYNLOADFLAG 0

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

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

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

staload _ = "prelude/DATS/list.dats"
staload _ = "prelude/DATS/list_vt.dats"

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

%{^
typedef char *charptr;
%} // end of [%{^]
abstype charptr = $extype"charptr"

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

%{^
#define ATS_MFREE free
#define ATS_MALLOC malloc
#define ATSextmcall(obj, mtd, funarg) obj.mtd funarg
%} // end of [%{^]

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

%{^
void *theList = NULL;
void *theList_get ()
{
  void *res;
  res = theList; theList = NULL; return res;
} /* end of [theList_get] */
%} // end of [%{^]
//
extern
fun
theList_get(): List0_vt(int) = "mac#"
//
(* ****** ****** *)

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)
//
fun
from
(
  m: int, n: int
) : List0_vt(int) =
(
if m < n
  then cons_vt (m, from(m+1, n)) else nil_vt ()
// end of [if]
) (* end of [from] *)
//
extvar "theList" = from(0, 10)
//
} (* end of [setup] *)
//
(* ****** ****** *)
//
implement
fprint_val<int>
  (out, x) =
  $extmcall(void, Serial, "print", x)
//
(* ****** ****** *)
//
(*
implement
fprint_string (out, x) = Serial_ptr.print(x)
*)
(* ****** ****** *)
//
implement
fprint_list_vt$sep<> (out) = ()
//
(* ****** ****** *)

staload MS = "./list_vt_mergesort.dats"

(* ****** ****** *)
//
extern
fun
loop (): void = "mac#"
//
implement
loop () =
myloop(0) where
{
//
fun
mysort{n:int}
(
  xs: list_vt(int, n)
) : list_vt(int, n) = let
//
implement
$MS.list_vt_mergesort$cmp<int>
  (x1, x2, n1, n2) = compare (x1, x2)
//
in
  list_vt_mergesort (xs)
end // end of [mysort]
//
fun
myrand{n:int}
(
  xs: list_vt(int, n)
) : list_vt(int, n) = let
//
implement
$MS.list_vt_mergesort$cmp<int>
  (x1, x2, n1, n2) =
(
  $effmask_all(if random(n1+n2) < n1 then 0 else 1)
)
//
in
  list_vt_mergesort (xs)
end // end of [myrand]
//
fun
myloop
(
  bit: int
) : void = let
//
val
out = $extval (FILEref, "0")
//
(*
val () = randomSeed($UN.cast{uint}(millis()))
*)
//
val xs = theList_get()
val () = fprint_list_vt (out, xs)
val () = Serial_ptr.println()
extvar "theList" =
  (if bit = 0 then myrand(xs) else mysort(xs)): List0_vt(int)
//
val () = digitalWrite(LEDPIN, 1)
val () = delay(250)
val () = digitalWrite(LEDPIN, 0)
val () = delay(1000)
//
in
  myloop (1-bit)
end // end of [myloop]
//
} (* end of [loop] *)
//
(* ****** ****** *)

(* end of [ListMergeSort.dats] *)


Removing old file

Removing old file


Updating: minorly improving

Updating: minorly improving

(*
#
# ListMergeSort
#
*)
(* ****** ****** *)

#define ATS_DYNLOADFLAG 0

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

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

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

staload _ = "prelude/DATS/list.dats"
staload _ = "prelude/DATS/list_vt.dats"
staload _ = "prelude/DATS/list_vt_mergesort.dats"

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

%{^
typedef char *charptr;
%} // end of [%{^]
abstype charptr = $extype"charptr"

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

%{^
#define ATS_MFREE free
#define ATS_MALLOC malloc
#define ATSextmcall(obj, mtd, funarg) obj.mtd funarg
%} // end of [%{^]

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

%{^
void *theList = NULL;
void *theList_get ()
{
  void *res;
  res = theList; theList = NULL; return res;
} /* end of [theList_get] */
%} // end of [%{^]
//
extern
fun
theList_get(): List0_vt(int) = "mac#"
//
(* ****** ****** *)

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)
//
fun
from
(
  m: int, n: int
) : List0_vt(int) =
(
if m < n
  then cons_vt (m, from(m+1, n)) else nil_vt ()
// end of [if]
) (* end of [from] *)
//
extvar "theList" = from(0, 10)
//
} (* end of [setup] *)
//
(* ****** ****** *)
//
implement
fprint_val<int>
  (out, x) =
  $extmcall(void, Serial, "print", x)
//
(* ****** ****** *)
//
(*
implement
fprint_string (out, x) = Serial_ptr.print(x)
*)
(* ****** ****** *)
//
implement
fprint_list_vt$sep<> (out) = ()
//
(* ****** ****** *)
//
extern
fun loop (): void = "mac#"
//
implement
loop () =
myloop(0) where
{
//
fun
mysort{n:int}
(
  xs: list_vt(int, n)
) : list_vt(int, n) = list_vt_mergesort (xs)
//
fun
myrand{n:int}
(
  xs: list_vt(int, n)
) : list_vt(int, n) = let
//
fun
aux{n:nat}
(
  xs: list_vt(int, n), n: int(n)
) : list_vt(int, n) =
(
if
n > 0
then let
//
val i =
$UN.cast{natLt(n)}(random(n))
val (xs1, xs2) = list_vt_split_at (xs, i)
val (xs21, xs22) = list_vt_split_at (xs2, 1)
val xs1_xs22 = list_vt_append (xs1, xs22)
//
in
  list_vt_append (xs21, aux(xs1_xs22, n-1))
end // end of [then]
else xs // end of [else]
) (* end of [aux] *)
//
prval () = lemma_list_vt_param (xs)
//
in
  aux (xs, list_vt_length(xs))
end // end of [myrand]
//
fun
myloop
(
  bit: int
) : void = let
//
val
out = $extval (FILEref, "0")
//
(*
val () = randomSeed($UN.cast{uint}(millis()))
*)
//
val xs = theList_get()
val () = fprint_list_vt (out, xs)
val () = Serial_ptr.println()
extvar "theList" =
  (if bit = 0 then myrand(xs) else mysort(xs)): List0_vt(int)
//
val () = digitalWrite(LEDPIN, 1)
val () = delay(250)
val () = digitalWrite(LEDPIN, 0)
val () = delay(1000)
//
in
  myloop (1-bit)
end // end of [myloop]
//
} (* end of [loop] *)
//
(* ****** ****** *)

(* end of [ListMergeSort.dats] *)

(*
#
# ListMergeSort
#
*)
(* ****** ****** *)

#define ATS_DYNLOADFLAG 0

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

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

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

staload _ = "prelude/DATS/list.dats"
staload _ = "prelude/DATS/list_vt.dats"
staload _ = "prelude/DATS/list_vt_mergesort.dats"

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

%{^
typedef char *charptr;
%} // end of [%{^]
abstype charptr = $extype"charptr"

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

%{^
#define ATS_MFREE free
#define ATS_MALLOC malloc
#define ATSextmcall(obj, mtd, funarg) obj.mtd funarg
%} // end of [%{^]

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

%{^
void *theList = NULL;
void *theList_get ()
{
  void *res;
  res = theList; theList = NULL; return res;
} /* end of [theList_get] */
%} // end of [%{^]
//
extern
fun
theList_get(): List0_vt(int) = "mac#"
//
(* ****** ****** *)

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)
//
fun
from
(
  m: int, n: int
) : List0_vt(int) =
(
if m < n
  then cons_vt (m, from(m+1, n)) else nil_vt ()
// end of [if]
) (* end of [from] *)
//
extvar "theList" = from(0, 10)
//
} (* end of [setup] *)
//
(* ****** ****** *)
//
implement
fprint_val<int>
  (out, x) =
  $extmcall(void, Serial, "print", x)
//
(* ****** ****** *)
//
implement
fprint_string (out, x) = Serial_ptr.print(x)
//
(* ****** ****** *)
//
extern
fun loop (): void = "mac#"
//
implement
loop () =
myloop(0) where
{
//
fun
mysort{n:int}
(
  xs: list_vt(int, n)
) : list_vt(int, n) = list_vt_mergesort (xs)
//
fun
myrand{n:int}
(
  xs: list_vt(int, n)
) : list_vt(int, n) = let
//
fun
aux{n:nat}
(
  xs: list_vt(int, n), n: int(n)
) : list_vt(int, n) =
(
if
n > 0
then let
//
val i =
$UN.cast{natLt(n)}(random(n))
val (xs1, xs2) = list_vt_split_at (xs, i)
val (xs21, xs22) = list_vt_split_at (xs2, 1)
val xs1_xs22 = list_vt_append (xs1, xs22)
//
in
  list_vt_append (xs21, aux(xs1_xs22, n-1))
end // end of [then]
else xs // end of [else]
) (* end of [aux] *)
//
prval () = lemma_list_vt_param (xs)
//
in
  aux (xs, list_vt_length(xs))
end // end of [myrand]
//
fun
myloop
(
  bit: int
) : void = let
//
val
out = $extval (FILEref, "0")
//
val () = randomSeed($UN.cast{uint}(micros()))
//
val xs = theList_get()
val () = fprint_list_vt (out, xs)
val () = Serial_ptr.println()
extvar "theList" =
  (if bit = 0 then myrand(xs) else mysort(xs)): List0_vt(int)
//
val () = digitalWrite(LEDPIN, 1)
val () = delay(250)
val () = digitalWrite(LEDPIN, 0)
val () = delay(1000)
//
in
  myloop (1-bit)
end // end of [myloop]
//
} (* end of [loop] *)
//
(* ****** ****** *)

(* end of [ListMergeSort.dats] *)


Updating: very minorly improving

Updating: very minorly improving

(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTcom
// Start time: February, 2016
//
(* ****** ****** *)
//
// Following a Promela-example in
// (Spin Model Checker Primer Reference)
//
(* ****** ****** *)

(*
proctype
Agent(chan listen; chan talk)
{
    do
    :: talk!hold(listen)
    :: talk!deny(listen) -> break
    :: talk!grant(listen) ->
        wait:
        listen?return0; break
    od;
    server!return0(listen)
}
*)

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

abstype channel

(* ****** ****** *)
//
extern
fun
channel_recv{a:type}(channel): a
extern
fun
channel_send{a:type}(channel, a): void
//
extern
fun
channel_create(cap: intGte(0)): channel
//
(* ****** ****** *)

extern
fun
channel_is_empty : channel -> bool
extern
fun
channel_isnot_empty : channel -> bool

(* ****** ****** *)
//
datatype
ClientOpt =
  | DENY of ()
  | DENY of (channel)
  | HOLD of (channel)
  | GRANT of (channel)
//
datatype
ClientReply = RETURN0 of ()
//
datatype
ServerOpt =
  | RETURN0 of (channel)
  | REQUEST0 of (channel)
//
(* ****** ****** *)
//
val
theServer = channel_create(0)
//
(* ****** ****** *)
//
extern
fun
Agent
(
  agent: channel, client: channel
) : void // end of [Agent]
//
(* ****** ****** *)

extern
val RANDOM: int

(* ****** ****** *)
//
implement
Agent(agent, client) = let
//
fun
loop
( agent: channel
, client: channel
) : void = (
//
case
RANDOM of
| 0 => let
    val () =
    channel_send(client, HOLD(agent))
  in
    loop(agent, client)
  end // end of [_]
| 1 =>
    channel_send(client, DENY(agent))
| _ => let
    val () =
    channel_send(client, GRANT(agent))
    val-RETURN0() =
      channel_recv{ClientReply}(agent)
    // end of [val]
  in
    // break
  end // end of [_]
//
) (* end of [loop] *)
//
val () = loop(agent, client)
//
in
  channel_send(theServer, agent)
end // end of [Agent]
//
(* ****** ****** *)

(*
#define M 2
active [M] proctype Client()
{
    chan me = [0] of { mtype, chan };
    chan agent;
end:
    do
    :: timeout ->
        server!request(me);
        do
        :: me?hold(agent)
        :: me?deny(agent) -> break
        :: me?grant(agent) -> agent!return0; break
        od
    od
}
*)

(* ****** ****** *)
//
extern
fun Client(): void
//
(* ****** ****** *)
//
implement
Client() = let
//
fun
loop
(
  client: channel
) : void =
(
//
case+
RANDOM
of // case
| _ => let
    val () =
    channel_send(theServer, REQUEST0(client))
  in
    loop2(client)
  end // end of [loop]
//
) (* end of [loop] *)
//
and
loop2
(
  client: channel
) : void = let
  val opt = channel_recv{ClientOpt}(client)
in
//
case+ opt of
| DENY() => ()
| DENY(agent) => ()
| HOLD(agent) => loop2(client)
| GRANT(agent) => channel_send(agent, RETURN0())
//
end // end of [loop2]
//
in
  loop(channel_create(0))
end // end of [Client]

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

(*
active
proctype Server()
{
    chan agents[N] = [0] of { mtype };
    chan pool = [N] of { chan };
    chan client, agent;
    byte i;
    do
    :: i < N -> pool!agents[i]; i++
    :: else -> break
    od;
    end:
    do
    :: server?request(client) ->
        if
        :: empty(pool) ->
            client!deny(0)
        :: nempty(pool) ->
            pool?agent;
            run Agent(agent,client)
        fi
    :: server?return0(agent) ->
        pool!agent
    od
}
*)

(* ****** ****** *)
//
extern
fun Server((*void*)): void
//
implement
Server() = let
//
fun
loop
(
  pool: channel
) : void = let
//
val
opt =
channel_recv{ServerOpt}(theServer)
//
in
//
case+ opt of
| RETURN0(agent) => let
    val () =
    channel_send{channel}(pool, agent)
  in
    loop(pool)
  end // end of [RETURN0]
| REQUEST0(client) =>
  if channel_isnot_empty(pool)
    then let
      val agent =
        channel_recv{channel}(pool)
      // end of [val]
      val () = Agent(agent, client)
    in
      loop(pool)
    end // end of [then]
    else let
      val () =
      channel_send(client, DENY((*void*)))
    in
      loop(pool)
    end // end of [else]
//
end // end of [loop]
//
val
pool = channel_create(5)
//
in
  loop(pool)
end // end of [Server]
//
(* ****** ****** *)

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

(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: gmhwxiATgmailDOTcom
// Start time: February, 2016
//
(* ****** ****** *)
//
// Following a Promela-example in
// (Spin Model Checker Primer Reference)
//
(* ****** ****** *)

(*
proctype
Agent(chan listen; chan talk)
{
    do
    :: talk!hold(listen)
    :: talk!deny(listen) -> break
    :: talk!grant(listen) ->
        wait:
        listen?return0; break
    od;
    server!return0(listen)
}
*)

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

abstype channel

(* ****** ****** *)
//
extern
fun
channel_recv{a:type}(channel): a
extern
fun
channel_send{a:type}(channel, a): void
//
extern
fun
channel_create(cap: intGte(0)): channel
//
(* ****** ****** *)

extern
fun
channel_is_empty : channel -> bool
extern
fun
channel_isnot_empty : channel -> bool

(* ****** ****** *)
//
datatype
ClientOpt =
| DENY of ()
| DENY of (channel)
| HOLD of (channel)
| GRANT of (channel)
//
datatype
ClientReply = RETURN0 of ()
//
datatype
ServerOpt =
  | RETURN0 of (channel)
  | REQUEST0 of (channel)
//
(* ****** ****** *)
//
val
theServer = channel_create(0)
//
(* ****** ****** *)
//
extern
fun
Agent
(
  agent: channel, client: channel
) : void // end of [Agent]
//
(* ****** ****** *)

extern val RAND: int

(* ****** ****** *)
//
implement
Agent(agent, client) = let
//
fun
loop
( agent: channel
, client: channel
) : void = (
//
case RAND of
| 0 => let
    val () =
    channel_send(client, HOLD(agent))
  in
    loop(agent, client)
  end // end of [_]
| 1 =>
    channel_send(client, DENY(agent))
| _ => let
    val () =
    channel_send(client, GRANT(agent))
    val-RETURN0() =
      channel_recv{ClientReply}(agent)
    // end of [val]
  in
    // break
  end // end of [_]
//
) (* end of [loop] *)
//
val () = loop(agent, client)
//
in
  channel_send(theServer, agent)
end // end of [Agent]
//
(* ****** ****** *)

(*
#define M 2
active [M] proctype Client()
{
    chan me = [0] of { mtype, chan };
    chan agent;
end:
    do
    :: timeout ->
        server!request(me);
        do
        :: me?hold(agent)
        :: me?deny(agent) -> break
        :: me?grant(agent) -> agent!return0; break
        od
    od
}
*)

(* ****** ****** *)
//
extern
fun Client(): void
//
(* ****** ****** *)
//
implement
Client() = let
//
fun
loop
(
  client: channel
) : void =
(
//
case+ RAND of
| _ => let
    val () =
    channel_send(theServer, REQUEST0(client))
  in
    loop2(client)
  end // end of [loop]
//
) (* end of [loop] *)
//
and
loop2
(
  client: channel
) : void = let
  val opt = channel_recv{ClientOpt}(client)
in
//
case+ opt of
| DENY() => ()
| DENY(agent) => ()
| HOLD(agent) => loop2(client)
| GRANT(agent) => channel_send(agent, RETURN0())
//
end // end of [loop2]
//
in
  loop(channel_create(0))
end // end of [Client]

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

(*
active
proctype Server()
{
    chan agents[N] = [0] of { mtype };
    chan pool = [N] of { chan };
    chan client, agent;
    byte i;
    do
    :: i < N -> pool!agents[i]; i++
    :: else -> break
    od;
    end:
    do
    :: server?request(client) ->
        if
        :: empty(pool) ->
            client!deny(0)
        :: nempty(pool) ->
            pool?agent;
            run Agent(agent,client)
        fi
    :: server?return0(agent) ->
        pool!agent
    od
}
*)

(* ****** ****** *)
//
extern
fun Server((*void*)): void
//
implement
Server() = let
//
fun
loop
(
  pool: channel
) : void = let
//
val
opt =
channel_recv{ServerOpt}(theServer)
//
in
//
case+ opt of
| RETURN0(agent) => let
    val () =
    channel_send{channel}(pool, agent)
  in
    loop(pool)
  end // end of [RETURN0]
| REQUEST0(client) =>
  if channel_isnot_empty(pool)
    then let
      val agent =
        channel_recv{channel}(pool)
      // end of [val]
      val () = Agent(agent, client)
    in
      loop(pool)
    end // end of [then]
    else let
      val () =
      channel_send(client, DENY((*void*)))
    in
      loop(pool)
    end // end of [else]
//
end // end of [loop]
//
val
pool = channel_create(5)
//
in
  loop(pool)
end // end of [Server]
//
(* ****** ****** *)

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


Updating: very very minorly

Updating: very very minorly

(* ****** ****** *)
//
// Templates for C++
//
(* ****** ****** *)
//
staload _ =
"prelude/DATS/integer.dats"
staload _ =
"prelude/DATS/pointer.dats"
//
(* ****** ****** *)
//
staload _ =
"prelude/DATS/integer_long.dats"
staload _ =
"prelude/DATS/integer_size.dats"
staload _ =
"prelude/DATS/integer_short.dats"
staload _ =
"prelude/DATS/integer_fixed.dats"
//
(* ****** ****** *)

staload _ = "prelude/DATS/bool.dats"
staload _ = "prelude/DATS/char.dats"
staload _ = "prelude/DATS/float.dats"
staload _ = "prelude/DATS/string.dats"

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

staload _ = "prelude/DATS/array.dats"
staload _ = "prelude/DATS/arrayptr.dats"
staload _ = "prelude/DATS/arrayref.dats"

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

staload UNSAFE = "prelude/SATS/unsafe.sats"
staload _(*UNSAFE*) = "prelude/DATS/unsafe.dats"

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

(* end of [staloadall.hats] *)

(* ****** ****** *)
//
// Templates for C++
//
(* ****** ****** *)
//
staload _ =
"prelude/DATS/integer.dats"
staload _ =
"prelude/DATS/pointer.dats"
//
(* ****** ****** *)
//
staload _ =
"prelude/DATS/integer_long.dats"
staload _ =
"prelude/DATS/integer_size.dats"
staload _ =
"prelude/DATS/integer_short.dats"
staload _ =
"prelude/DATS/integer_fixed.dats"
//
(* ****** ****** *)

staload _ = "prelude/DATS/bool.dats"
staload _ = "prelude/DATS/char.dats"
staload _ = "prelude/DATS/string.dats"

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

staload _ = "prelude/DATS/array.dats"
staload _ = "prelude/DATS/arrayptr.dats"
staload _ = "prelude/DATS/arrayref.dats"

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

staload UNSAFE = "prelude/SATS/unsafe.sats"
staload _(*UNSAFE*) = "prelude/DATS/unsafe.dats"

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

(* end of [staloadall.hats] *)