(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2011-2014 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
** 
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
** 
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

(* ****** ****** *)
//
// Author: Hongwei Xi
// Authoremail: hwxiATcsDOTbuDOTedu
//
// This one was
// there at the very beginning of ATS
//
(* ****** ****** *)
//
(*
HX: fixity declarations
*)
#include "prelude/params.hats"
//
(* ****** ****** *)

#if VERBOSE_FIXITY #then
#print "Loading [fixity.ats] starts!\n"
#endif // end of [VERBOSE_FIXITY]

(* ****** ****** *)
//
(*
prefix 00 ! (* static *)
*)
//
prefix 99 ! (* dynamic *)
//
(* ****** ****** *)

(*
prefix 81 ID (* identity *)
*)

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

(*
postfix 80 .lab // dynamic
postfix 80 ->lab // dynamic
*)

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

(*
prefix 79 & // dynamic
*)

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

(*
infixl 70 app
*)

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

(*
postfix 69 ?
*)

(* ****** ****** *)
//
// HX-2015-08-04:
// mostly following the Fortran convention
//
(* ****** ****** *)

infixr 61 ** (*exp*)

(* ****** ****** *)
//
// multiplicative
//
infixl 60 * / % mod
//
(*
infixl 60 nmul ndiv nmod
*)
//
(* ****** ****** *)

prefix 51 ~ (*negative*)

(* ****** ****** *)
//
infixl 50 + - (*additive*)
//
(*
infixr (+) ++ // concatenative
*)
//
(* ****** ****** *)

infixl 41 asl asr
infixl 41 lsl lsr

(* ****** ****** *)
//
infix 40 < <= > >=
//
(*
//
// HX-2012-07: removed
//
infixl ( < ) ilt flt plt ult
infixl ( <= ) ilte flte plte ulte
infixl ( > ) igt fgt pgt ugt
infixl ( >= ) igte fgte pgte ugte
*)
//
(* ****** ****** *)

infixr 40 :: @

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

infix 30 = == != <>

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

(*
//
// HX-2012-07: removed
//
infix ( = ) ieq feq peq ueq
infix ( <> ) ineq fneq pneq uneq
*)

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

infixl 21 &&
infixl ( && ) andalso land

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

infixl 20 ||
infixl ( || ) xor orelse lor lxor

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

infixr 10 ->

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

infix 0 := // HX: assign
infix 0 :=: // HX: exchange

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

infixl 0 << (* g0int_asl, g0uint_lsl *)
infixr 0 >> (* g0int_asr, g0uint_lsr *)

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

prefix 0 ++ -- // inc and dec
prefix 0 !++ --! // getinc and decget
infixr 0 =++ --= // setinc and decset

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

infix 0 :+= :-= :*= :/= // x:=x+a, x:=x-a, ...
infix 0 :=+ :=- :=* :=/ // x:=a+x, x:=a-x, ...

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

prefix 0 ignoret // ignoring a funcall return

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

#if VERBOSE_FIXITY #then
#print "Loading [fixity.ats] finishes!\n"
#endif // end of [VERBOSE_FIXITY]

(* end of [fixity.ats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2013 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

(* ****** ****** *)
//
// Author of the file:
// Hongwei Xi (gmhwxiATgmailDOTcom)
// Start Time: September, 2011
//
(* ****** ****** *)

#include "prelude/params.hats"

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

#if VERBOSE_PRELUDE #then
#print "Loading [basics_pre.sats] starts!\n"
#endif // end of [VERBOSE_PRELUDE]

(* ****** ****** *)
//
// HX:
// some built-in static boolean constants
//
stacst
true_bool : bool = "ext#"
stacst
false_bool : bool = "ext#"
//
stadef
true = true_bool and false = false_bool
//
// HX: boolean negation
//
stacst
neg_bool
  : bool -> bool = "ext#"
//
stadef ~ = neg_bool // overloaded
stadef not = neg_bool // overloaded
//
// HX: disjunction
//
stacst
add_bool_bool
  : (bool, bool) -> bool = "ext#"
//
// HX: disjunction
//
stacst
mul_bool_bool
  : (bool, bool) -> bool = "ext#"
//
stadef + = add_bool_bool and * = mul_bool_bool
stadef || = add_bool_bool and && = mul_bool_bool
//
stacst lt_bool_bool
  : (bool, bool) -> bool = "ext#"
stacst lte_bool_bool
  : (bool, bool) -> bool = "ext#"
//
stacst gt_bool_bool
  : (bool, bool) -> bool = "ext#"
stacst gte_bool_bool
  : (bool, bool) -> bool = "ext#"
//
stadef < = lt_bool_bool and <= = lte_bool_bool
stadef > = gt_bool_bool and >= = gte_bool_bool
//
stacst eq_bool_bool
  : (bool, bool) -> bool = "ext#"
stacst neq_bool_bool
  : (bool, bool) -> bool = "ext#"
//
stadef == = eq_bool_bool
stadef != = neq_bool_bool
stadef <> = neq_bool_bool (* for backward compatibility *)
//
(* ****** ****** *)

(*
//
// HX-2012-06-12: removed
//
stacst
eq_char_char
  : (char, char) -> bool = "ext#"
stacst
neq_char_char
  : (char, char) -> bool = "ext#"
//
stadef == = eq_char_char
stadef != = neq_char_char
stadef <> = neq_char_char (* for backward compatibility *)
//
*)

(* ****** ****** *)
//
stacst
neg_int
  : (int) -> int = "ext#"
//
stadef ~ = neg_int // overloaded
//
stacst
add_int_int
  : (int, int) -> int = "ext#"
stacst
sub_int_int
  : (int, int) -> int = "ext#"
stacst
mul_int_int
  : (int, int) -> int = "ext#"
stacst
div_int_int
  : (int, int) -> int = "ext#"
//
stadef + = add_int_int and - = sub_int_int
stadef * = mul_int_int and / = div_int_int
//
// HX: ndiv: divisor is positive
// HX: idiv: alias for div_int_int
//
stacst
ndiv_int_int
  : (int, int) -> int = "ext#"
stacst
idiv_int_int
  : (int, int) -> int = "ext#"
//
stadef ndiv = ndiv_int_int // divided by nat
stadef idiv = idiv_int_int // divided by int
//
stadef
nmod_int_int
(
  x:int, y:int
) = x - y * (x \ndiv_int_int y)
//
stadef mod = nmod_int_int
stadef nmod = nmod_int_int
stadef % (*adopted from C*) = nmod_int_int
//
(* ****** ****** *)
//
stacst lt_int_int
  : (int, int) -> bool = "ext#"
stacst lte_int_int
  : (int, int) -> bool = "ext#"
//
stacst gt_int_int
  : (int, int) -> bool = "ext#"
stacst gte_int_int
  : (int, int) -> bool = "ext#"
//
stadef < = lt_int_int and <= = lte_int_int
stadef > = gt_int_int and >= = gte_int_int
//
stacst eq_int_int
  : (int, int) -> bool = "ext#"
stacst neq_int_int
  : (int, int) -> bool = "ext#"
//
stadef == = eq_int_int
stadef != = neq_int_int
stadef <> = neq_int_int (* for backward compatibility *)
//
(* ****** ****** *)
//
stacst
abs_int
  : (int) -> int = "ext#"
//
stadef
absrel_int_int
  (x: int, v: int): bool =
  (x >= 0 && x == v) || (x <= 0 && ~x == v)
//
stadef abs = abs_int
stadef absrel = absrel_int_int
//
stacst
sgn_int
  : (int) -> int = "ext#"
//
stadef
sgnrel_int_int
  (x: int, v: int): bool =
  (x > 0 && v==1) || (x==0 && v==0) || (x < 0 && v==(~1))
//
stadef sgn = sgn_int
stadef sgnrel = sgnrel_int_int
//
stacst
max_int_int
  : (int, int) -> int = "ext#"
stacst
min_int_int
  : (int, int) -> int = "ext#"
//
stadef
maxrel_int_int_int
  (x: int, y: int, v: int): bool =
  (x >= y && x == v) || (x <= y && y == v)
//
stadef
minrel_int_int_int
  (x: int, y: int, v: int): bool =
  (x >= y && y == v) || (x <= y && x == v)
//
stadef max = max_int_int
stadef min = min_int_int
stadef maxrel = maxrel_int_int_int
stadef minrel = minrel_int_int_int
//
stadef
nsub (x:int, y:int) = max (x-y, 0)
//
stadef
ndivrel_int_int_int // HX: y > 0
  (x: int, y: int, q: int): bool =
  (q * y <= x) && (x < q * y + y)
//
stadef ndivrel = ndivrel_int_int_int
//
stadef
idivrel_int_int_int
  (x: int, y: int, q: int) = ( // HX: y != 0
  x >= 0 && y > 0 && ndivrel_int_int_int ( x,  y,  q)
) || (
  x >= 0 && y < 0 && ndivrel_int_int_int ( x, ~y, ~q)
) || (
  x <  0 && y > 0 && ndivrel_int_int_int (~x,  y, ~q)
) || (
  x <  0 && y < 0 && ndivrel_int_int_int (~x, ~y,  q)
) (* end of [idivrel_int_int_int] *)
//
stadef idivrel = idivrel_int_int_int
//
stadef
divmodrel_int_int_int_int
  (x: int, y: int, q: int, r: int) : bool =
  (0 <= r && r < y && x == q*y + r)
//
stadef divmodrel = divmodrel_int_int_int_int
//
(* ****** ****** *)
//
stacst
ifint_bool_int_int
  : (bool, int, int) -> int = "ext#"
//
stadef
ifintrel_bool_int_int_int
(
  b:bool, x:int, y:int, r:int
) : bool = (b && r==x) || (~b && r==y)
//
stadef ifint = ifint_bool_int_int
stadef ifintrel = ifintrel_bool_int_int_int
//
(* ****** ****** *)

stadef
bool2int(b: bool): int = ifint(b, 1, 0)
stadef int2bool (i: int): bool = (i != 0)
stadef b2i = bool2int and i2b = int2bool

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

(*
** HX: [char] = [int8]
** HX-2012-06-12: removed
//
stacst
int_of_char: char -> int = "ext#"
stacst
char_of_int : int -> char = "ext#"
//
stadef c2i = int_of_char and i2c = char_of_int
//
*)

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

(*
** HX: pointer <-> integer
*)
stacst int_of_addr: addr -> int = "ext#"
stacst addr_of_int: int -> addr = "ext#"
stadef a2i = int_of_addr and i2a = addr_of_int

(* ****** ****** *)
//
stadef pow2_7 = 128
stadef pow2_8 = 256
stadef i2u_int8 (i:int) = ifint (i >= 0, i, i+pow2_8)
stadef i2u8 = i2u_int8
stadef u2i_int8 (u:int) = ifint (u < pow2_7, u, u-pow2_8)
stadef u2i8 = u2i_int8
//
stadef pow2_15 = 32768
stadef pow2_16 = 65536
stadef i2u_int16 (i:int) = ifint (i >= 0, i, i+pow2_16)
stadef i2u16 = i2u_int16
stadef u2i_int16 (u:int) = ifint (u < pow2_15, u, u-pow2_16)
stadef u2i16 = u2i_int16
//
(* ****** ****** *)

stadef pow2_32 = 0x100000000
stadef pow2_64 = 0x10000000000000000

(* ****** ****** *)
//
stacst
null_addr : addr = "ext#"
stadef
null = null_addr and NULL = null_addr
//
stacst add_addr_int
  : (addr, int) -> addr = "ext#"
stacst sub_addr_int
  : (addr, int) -> addr = "ext#"
stacst sub_addr_addr
  : (addr, addr) -> int = "ext#"
//
stadef + = add_addr_int
stadef - = sub_addr_int
stadef - = sub_addr_addr
//
(* ****** ****** *)
//
stacst lt_addr_addr
  : (addr, addr) -> bool = "ext#"
stacst lte_addr_addr
  : (addr, addr) -> bool = "ext#"
//
stadef < = lt_addr_addr
stadef <= = lte_addr_addr
//
stacst gt_addr_addr
  : (addr, addr) -> bool = "ext#"
stacst gte_addr_addr
  : (addr, addr) -> bool = "ext#"
//
stadef > = gt_addr_addr
stadef >= = gte_addr_addr
//
stacst eq_addr_addr
  : (addr, addr) -> bool = "ext#"
stacst neq_addr_addr
  : (addr, addr) -> bool = "ext#"
//
stadef == = eq_addr_addr
stadef != = neq_addr_addr
stadef <> = neq_addr_addr (* for backward compatibility *)
//
(* ****** ****** *)
//
// HX-2013-09:
// for supporting inheritance in OOP
//
stacst
lte_cls_cls : (cls, cls) -> bool = "ext#"
stacst
gte_cls_cls : (cls, cls) -> bool = "ext#"
//
stadef <= = lte_cls_cls and >= = gte_cls_cls
//
stadef
lterel_cls_cls
(
  c1: cls, c2: cls, lterel_cls_cls_res: bool
) : bool = lterel_cls_cls_res // end-of-stadef
stadef
gterel_cls_cls
(
  c1: cls, c2: cls, gterel_cls_cls_res: bool
) : bool = gterel_cls_cls_res // end-of-stadef
//
(* ****** ****** *)
//
// HX: this is a special constant!
//
stacst
sizeof_t0ype_int : t@ype -> int = "ext#"
stadef
sizeof(a:viewt@ype): int = sizeof_t0ype_int (a?)
//
(* ****** ****** *)

sortdef nat = { i:int | i >= 0 } // natural numbers
sortdef pos = { i:int | i > 0 }
sortdef neg = { i:int | i < 0 }
sortdef npos = { i:int | i <= 0 } // non-positive integers

sortdef nat1 = { n:nat | n < 1 } // for 0
sortdef nat2 = { n:nat | n < 2 } // for 0, 1
sortdef nat3 = { n:nat | n < 3 } // for 0, 1, 2
sortdef nat4 = { n:nat | n < 4 } // for 0, 1, 2, 3

sortdef sgn = { i:int | ~1 <= i; i <= 1 }

sortdef agz = { l:addr | l > null }
sortdef agez = { l:addr | l >= null }
sortdef alez = { l:addr | l <= null }

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

#define CHAR_MAX 127
#define CHAR_MIN ~128
#define UCHAR_MAX 0xFF

(* ****** ****** *)
//
stacst effnil : eff // nothing
stacst effall : eff // everything
//
stacst effntm : eff // nonterm
stacst effexn : eff // exception
stacst effref : eff // reference
stacst effwrt : eff // writeover
//
stacst add_eff_eff : (eff, eff) -> eff
stadef + = add_eff_eff // union of effsets
stacst sub_eff_eff : (eff, eff) -> eff
stadef - = add_eff_eff // difference of effsets
//
(* ****** ****** *)
//
// HX: some overloaded symbols
//
symintr ~ not
(*
symintr && || // macros
*)
symintr lnot lor lxor land
symintr + - * / % mod ndiv nmod
symintr < <= > >= = == != <> compare
symintr isltz isltez isgtz isgtez iseqz isneqz
symintr neg abs max min
symintr succ pred half double
symintr square sqrt cube cbrt pow
//
symintr ! [] // deref subscript
symintr << >> // for L/R-shifting
//
symintr inc dec
symintr ++ -- // inc and dec
symintr get set exch
symintr getinc setinc exchinc
symintr decget decset decexch
symintr !++ --! // getinc and decget
symintr =++ --= // setinc and decset
//
symintr assert
//
symintr encode decode
//
symintr uncons unsome
//
symintr ptrcast (* taking the address of a boxed val *)
symintr g0ofg1 g1ofg0 (* casting: indexed <-> un-indexed *)
//
symintr copy free length
//
symintr print prerr fprint gprint
symintr println prerrln fprintln gprintln
//
(*
//
symintr forall
symintr iforall
//
symintr foreach
symintr foreach2
symintr iforeach
symintr rforeach
//
*)
//
symintr ofstring ofstrptr
symintr tostring tostrptr
//
(* ****** ****** *)
//
// HX-2014-02:
// for dot-notation overloading
//
symintr .size
symintr .len .length
symintr .get .set .exch
symintr .nrow .ncol
symintr .head .tail
symintr .next .prev
symintr .init .last
symintr .eval // HX: convention: using "!"
//
(* ****** ****** *)
//
// HX-2012-05-23: for template args
//
abstype atstkind_type(tk: tkind)
//
abst@ype atstkind_t0ype(tk: tkind)
//
typedef
tkind_type(tk:tkind) = atstkind_type(tk)
typedef
tkind_t0ype(tk:tkind) = atstkind_t0ype(tk)
//
(* ****** ****** *)
//
absview // S2Eat
at_vt0ype_addr_view(a:vt@ype+, l:addr)
//
viewdef @ // HX: @ is infix
  (a:vt@ype, l:addr) = at_vt0ype_addr_view(a, l)
//
(* ****** ****** *)
//
abst@ype clo_t0ype_t0ype(a:t@ype) = a
absvt@ype clo_vt0ype_vt0ype(a:vt@ype) = a
//
(* ****** ****** *)
(*
absview
read_view_int_int_view
  (v:view, stamp:int, n:int)
stadef
READ = read_view_int_int_view
viewdef
READ (v:view) = [s,n:int] READ (v, s, n)
stadef RD = READ
//
absview
readout_view_int_view (v:view, stamp:int)
stadef
READOUT = readout_view_int_view
viewdef
READOUT (v:view) = [s:int] READOUT (v, s)
//
absvt@ype
read_vt0ype_int_int_vt0ype
  (a:vt@ype, stamp:int, n:int) = a
stadef
READ = read_vt0ype_int_int_vt0ype
vtypedef
READ (a:vt@ype) = [s,n:int] READ (a, s, n)
stadef RD = READ
//
absvt@ype
readout_vt0ype_int_vt0ype
  (a:vt@ype, stamp: int) = a
stadef
READOUT = readout_vt0ype_int_vt0ype
vtypedef
READOUT (a:vt@ype) = [s:int] READOUT (a, s)
*)

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

(*
absvt@ype
write_vt0ype_vt0ype(a: vt@ype) = a
vtypedef
WRITE(a:vt@ype) = write_vt0ype_vt0ype (a)
stadef WR = WRITE
*)

(* ****** ****** *)
//
vtypedef READ (a:vt@ype) = a // HX: used as a comment
vtypedef WRITE (a:vt@ype) = a // HX: used as a comment (rarely)
//
(*
vtypedef SHARED (a:vt@ype) = a // HX: used as a comment
vtypedef NSHARED (a:vt@ype) = a // HX: used as a comment (rarely)
*)
//
(* ****** ****** *)
//
absprop invar_prop_prop (a:prop)
absview invar_view_view (a:view)
//
abst@ype // S2Einvar
invar_t0ype_t0ype (a:t@ype) = a
absvt@ype // S2Einvar
invar_vt0ype_vt0ype (a:vt@ype) = a
//
// HX: this order is significant
// 
viewdef
INV (a: view) = invar_view_view (a)
propdef
INV (a: prop) = invar_prop_prop (a)
//
vtypedef INV
  (a:vt@ype) = invar_vt0ype_vt0ype (a)
//
vtypedef
INV (a: t@ype) = invar_t0ype_t0ype (a)
//
(* ****** ****** *)
(*
//
absprop optarg_prop_prop (a:prop)
absview optarg_view_view (a:view)
//
abst@ype
optarg_t0ype_t0ype (a:t@ype) = a
absvt@ype
optarg_vt0ype_vt0ype (a:vt@ype) = a
//
// HX: this order is significant
// 
viewdef
OPT (a: view) = optarg_view_view (a)
propdef
OPT (a: prop) = optarg_prop_prop (a)
//
vtypedef OPT
  (a:vt@ype) = optarg_vt0ype_vt0ype (a)
//
vtypedef
OPT (a: t@ype) = optarg_t0ype_t0ype (a)
//
*)
(* ****** ****** *)
//
abst@ype
stamped_t0ype(a:t@ype, int) = a
absvt@ype
stamped_vt0ype(a:vt@ype, int) = a
//
stadef stamped_t = stamped_t0ype
stadef stamped_vt = stamped_vt0ype
//
(* ****** ****** *)
//
absview
vcopyenv_view_view(v:view)
absvt@ype
vcopyenv_vt0ype_vt0ype(vt: vt0ype) = vt
//
stadef vcopyenv_v = vcopyenv_view_view
stadef vcopyenv_vt = vcopyenv_vt0ype_vt0ype
//
(* ****** ****** *)

#if VERBOSE_PRELUDE #then
#print "Loading [basics_pre.sats] finishes!\n"
#endif // end of [VERBOSE_PRELUDE]

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

(* end of [basics_pre.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2013 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

(* ****** ****** *)
//
// Author of the file:
// Hongwei Xi (gmhwxiATgmailDOTcom)
// Start Time: September, 2011
//
(* ****** ****** *)

#include "prelude/params.hats"

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

#if VERBOSE_PRELUDE #then
#print "Loading [basics_sta.sats] starts!\n"
#endif // end of [VERBOSE_PRELUDE]

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

#define RD(x) x // for commenting: read-only

(* ****** ****** *)
(*
//
// HX-2012-05-24:
// the following two styles are equivalent:
//
stadef
bool_kind = $extkind"atstype_bool"
tkindef bool_kind = "atstype_bool"
*)
(* ****** ****** *)
//
tkindef bool_kind = "atstype_bool"
//
abst@ype
bool_t0ype = tkind_t0ype (bool_kind)
stadef bool = bool_t0ype // shorthand
abst@ype
bool_bool_t0ype (b: bool) = bool_t0ype
stadef bool = bool_bool_t0ype // shorthand
//
typedef Bool = [b:bool] bool (b)
typedef boolLte
  (b1:bool) = [b2:bool] bool (b2 <= b1) // b2 -> b1
typedef boolGte
  (b1:bool) = [b2:bool] bool (b2 >= b1) // b1 -> b2
//
abst@ype atstype_bool // HX-2013-09: for internal use
//
(* ****** ****** *)

tkindef
byte_kind = "atstype_byte"
abst@ype
byte_t0ype = tkind_t0ype (byte_kind)
stadef byte = byte_t0ype

(* ****** ****** *)
//
// char is signed
//
sortdef int8 = {
  i:int | ~128 <= i; i < 128
} // end of [int8]
sortdef uint8 =
  { i:int | 0 <= i; i < 256 }
// end of [uint8]
//
tkindef char_kind = "atstype_char"
//
abst@ype
char_t0ype = tkind_t0ype(char_kind)
abst@ype
char_int_t0ype(c:int) = char_t0ype
//
stadef char = char_t0ype // shorthand
stadef char = char_int_t0ype // shorthand
//
typedef Char = [c:int8] char(c)
typedef charNZ = [c:int8 | c != 0] char(c)
//
// signed characters
//
tkindef schar_kind = "atstype_schar"
//
abst@ype
schar_t0ype = tkind_t0ype(schar_kind)
abst@ype
schar_int_t0ype (c:int) = schar_t0ype
//
stadef schar = schar_t0ype // shorthand
stadef schar = schar_int_t0ype // shorthand
typedef sChar = [c:int8] schar(c)
typedef scharNZ = [c:int8 | c != 0] schar(c)
//
// unsigned characters
//
tkindef uchar_kind = "atstype_uchar"
//
abst@ype
uchar_t0ype = tkind_t0ype(uchar_kind)
abst@ype
uchar_int_t0ype (c:int) = uchar_t0ype
//
stadef uchar = uchar_t0ype // shorthand
stadef uchar = uchar_int_t0ype // shorthand
typedef uChar = [c:uint8] uchar (c)
typedef scharNZ = [c:uint8 | c != 0] uchar(c)
//
(* ****** ****** *)

sortdef tk = tkind

(* ****** ****** *)
//
abst@ype
g0int_t0ype (tk:tk) = tkind_t0ype (tk)
stadef g0int = g0int_t0ype // shorthand
abst@ype
g1int_int_t0ype (tk:tkind, int) = g0int (tk)
stadef g1int = g1int_int_t0ype // shorthand
//
typedef g1int (tk:tkind) = [i:int] g1int (tk, i)
typedef g1int0 (tk:tkind) = [i:int | i >= 0] g1int (tk, i)
typedef g1int1 (tk:tkind) = [i:int | i >= 1] g1int (tk, i)
//
(* ****** ****** *)
//
typedef g1intLt
  (tk:tk, n:int) = [i:int | i < n] g1int (tk, i)
typedef g1intLte
  (tk:tk, n:int) = [i:int | i <= n] g1int (tk, i)
typedef g1intGt
  (tk:tk, n:int) = [i:int | i > n] g1int (tk, i)
typedef g1intGte
  (tk:tk, n:int) = [i:int | i >= n] g1int (tk, i)
typedef g1intBtw
  (tk:tk, lb:int, ub:int) = [i: int | lb <= i; i < ub] g1int (tk, i)
typedef g1intBtwe
  (tk:tk, lb:int, ub:int) = [i: int | lb <= i; i <= ub] g1int (tk, i)
//
(* ****** ****** *)
//
abst@ype
g0uint_t0ype (tk:tkind) = tkind_t0ype (tk)
stadef g0uint = g0uint_t0ype // shorthand
abst@ype
g1uint_int_t0ype (tk:tkind, int) = g0uint (tk)
stadef g1uint = g1uint_int_t0ype // shorthand
//
typedef g1uint (tk:tk) = [i:int] g1uint (tk, i)
typedef g1uint0 (tk:tk) = [i:int | i >= 0] g1uint (tk, i)
typedef g1uint1 (tk:tk) = [i:int | i >= 1] g1uint (tk, i)
//
(* ****** ****** *)
//
typedef g1uintLt
  (tk:tk, n:int) = [i:nat | i < n] g1uint (tk, i)
typedef g1uintLte
  (tk:tk, n:int) = [i:nat | i <= n] g1uint (tk, i)
typedef g1uintGt
  (tk:tk, n:int) = [i:int | i > n] g1uint (tk, i)
typedef g1uintGte
  (tk:tk, n:int) = [i:int | i >= n] g1uint (tk, i)
typedef g1uintBtw
  (tk:tk, lb:int, ub:int) = [i: int | lb <= i; i < ub] g1uint (tk, i)
typedef g1uintBtwe
  (tk:tk, lb:int, ub:int) = [i: int | lb <= i; i <= ub] g1uint (tk, i)
//
(* ****** ****** *)
//
tkindef int_kind = "atstype_int"
//
typedef int0 = g0int (int_kind)
typedef int1 (i:int) = g1int (int_kind, i)
//
stadef int = int1 // 2nd-select
stadef int = int0 // 1st-select
//
typedef Int = [i:int] int1 (i)
typedef Nat = [i:int | i >= 0] int1 (i)
//
typedef intLt (n:int) = g1intLt (int_kind, n)
typedef intLte (n:int) = g1intLte (int_kind, n)
typedef intGt (n:int) = g1intGt (int_kind, n)
typedef intGte (n:int) = g1intGte (int_kind, n)
typedef intBtw (lb:int, ub:int) = g1intBtw (int_kind, lb, ub)
typedef intBtwe (lb:int, ub:int) = g1intBtwe (int_kind, lb, ub)
//
typedef Two = intBtw (0, 2)
typedef Sgn = intBtwe (~1, 1)
//
typedef natLt (n:int) = intBtw (0, n)
typedef natLte (n:int) = intBtwe (0, n)
//
tkindef uint_kind = "atstype_uint"
//
typedef uint0 = g0uint (uint_kind)
typedef uint1 (n:int) = g1uint (uint_kind, n)
//
stadef uint = uint1 // 2nd-select
stadef uint = uint0 // 1st-select
//
stadef uInt = [n:int] uint1 (n)
//
typedef uintLt (n:int) = g1uintLt (uint_kind, n)
typedef uintLte (n:int) = g1uintLte (uint_kind, n)
typedef uintGt (n:int) = g1uintGt (uint_kind, n)
typedef uintGte (n:int) = g1uintGte (uint_kind, n)
typedef uintBtw (lb:int, ub:int) = g1uintBtw (uint_kind, lb, ub)
typedef uintBtwe (lb:int, ub:int) = g1uintBtwe (uint_kind, lb, ub)
//
abst@ype atstype_int // HX-2013-09: for internal use
abst@ype atstype_uint // HX-2013-09: for internal use
//
(* ****** ****** *)
//
tkindef
lint_kind = "atstype_lint"
typedef
lint0 = g0int (lint_kind)
typedef
lint1 (i:int) = g1int (lint_kind, i)
stadef lint = lint1 // 2nd-select
stadef lint = lint0 // 1st-select
//
tkindef
ulint_kind = "atstype_ulint"
typedef
ulint0 = g0uint (ulint_kind)
typedef
ulint1 (i:int) = g1uint (ulint_kind, i)
stadef ulint = ulint1 // 2nd-select
stadef ulint = ulint0 // 1st-select
//
tkindef
llint_kind = "atstype_llint"
typedef llint0 = g0int (llint_kind)
typedef llint1 (i:int) = g1int (llint_kind, i)
stadef llint = llint1 // 2nd-select
stadef llint = llint0 // 1st-select
//
tkindef
ullint_kind = "atstype_ullint"
typedef
ullint0 = g0uint (ullint_kind)
typedef
ullint1 (i:int) = g1uint (ullint_kind, i)
stadef ullint = ullint1 // 2nd-select
stadef ullint = ullint0 // 1st-select
//
(* ****** ****** *)
//
tkindef
intptr_kind = "atstype_intptr"
typedef
intptr0 = g0int (intptr_kind)
typedef
intptr1 (i:int) = g1int (intptr_kind, i)
stadef intptr = intptr1 // 2nd-select
stadef intptr = intptr0 // 1st-select
//
tkindef
uintptr_kind = "atstype_uintptr"
typedef
uintptr0 = g0uint (uintptr_kind)
typedef
uintptr1 (i:int) = g1uint (uintptr_kind, i)
stadef uintptr = uintptr1 // 2nd-select
stadef uintptr = uintptr0 // 1st-select
//
(* ****** ****** *)
//
tkindef
sint_kind = "atstype_sint"
typedef
sint0 = g0int (sint_kind)
typedef
sint1 (i:int) = g1int (sint_kind, i)
stadef sint = sint1 // 2nd-select
stadef sint = sint0 // 1st-select
//
tkindef
usint_kind = "atstype_usint"
typedef
usint0 = g0uint (usint_kind)
typedef
usint1 (i:int) = g1uint (usint_kind, i)
stadef usint = usint1 // 2nd-select
stadef usint = usint0 // 1st-select
//
(* ****** ****** *)
//
tkindef
size_kind = "atstype_size"
typedef size0_t = g0uint (size_kind)
typedef size1_t (i:int) = g1uint (size_kind, i)
//
stadef size_t = size1_t // 2nd-select
stadef size_t = size0_t // 1st-select
//
typedef Size =
  [i:int | i >= 0] g1uint (size_kind, i)
typedef Size_t = Size
//
typedef sizeLt (n:int) = g1uintLt (size_kind, n)
typedef sizeLte (n:int) = g1uintLte (size_kind, n)
typedef sizeGt (n:int) = g1uintGt (size_kind, n)
typedef sizeGte (n:int) = g1uintGte (size_kind, n)
typedef sizeBtw (lb:int, ub:int) = g1uintBtw (size_kind, lb, ub)
typedef sizeBtwe (lb:int, ub:int) = g1uintBtwe (size_kind, lb, ub)
//
tkindef
ssize_kind = "atstype_ssize"
typedef ssize0_t = g0int (ssize_kind)
typedef ssize1_t (i:int) = g1int (ssize_kind , i) 
//
stadef ssize_t = ssize1_t // 2nd-select
stadef ssize_t = ssize0_t // 1st-select
//
typedef SSize =
  [i:int] g1int (ssize_kind, i)
typedef SSize_t = SSize
//
typedef ssizeLt (n:int) = g1intLt (ssize_kind, n)
typedef ssizeLte (n:int) = g1intLte (ssize_kind, n)
typedef ssizeGt (n:int) = g1intGt (ssize_kind, n)
typedef ssizeGte (n:int) = g1intGte (ssize_kind, n)
typedef ssizeBtw (lb:int, ub:int) = g1intBtw (ssize_kind, lb, ub)
typedef ssizeBtwe (lb:int, ub:int) = g1intBtwe (ssize_kind, lb, ub)
//
abst@ype atstype_size // HX-2013-09: for internal use
abst@ype atstype_ssize // HX-2013-09: for internal use
//
(* ****** ****** *)

typedef sizeof_t (a:vt@ype) = size_t (sizeof(a?))

(* ****** ****** *)
//
tkindef
int8_kind = "atstype_int8"
typedef
int8_0 = g0int (int8_kind)
typedef
int8_1
  (i:int) = g1int (int8_kind, i)
//
stadef int8 = int8_1 // 2nd-select
stadef int8 = int8_0 // 1st-select
stadef Int8 = [i:int] int8_1 (i)
//
tkindef
uint8_kind = "atstype_uint8"
typedef
uint8_0 = g0uint (uint8_kind)
typedef
uint8_1
  (i:int) = g1uint (uint8_kind, i)
//
stadef uint8 = uint8_1 // 2nd-select
stadef uint8 = uint8_0 // 1st-select
stadef uInt8 = [i:nat] uint8_1 (i)
//
(* ****** ****** *)
//
tkindef
int16_kind = "atstype_int16"
typedef
int16_0 = g0int (int16_kind)
typedef
int16_1
  (i:int) = g1int (int16_kind, i)
//
stadef int16 = int16_1 // 2nd-select
stadef int16 = int16_0 // 1st-select
stadef Int16 = [i:int] int16_1 (i)
//
tkindef
uint16_kind = "atstype_uint16"
typedef
uint16_0 = g0uint (uint16_kind)
typedef
uint16_1
  (i:int) = g1uint (uint16_kind, i)
//
stadef uint16 = uint16_1 // 2nd-select
stadef uint16 = uint16_0 // 1st-select
stadef uInt16 = [i:nat] uint16_1 (i)
//
(* ****** ****** *)
//
tkindef
int32_kind = "atstype_int32"
typedef
int32_0 = g0int (int32_kind)
typedef
int32_1
  (i:int) = g1int (int32_kind, i)
//
stadef int32 = int32_1 // 2nd-select
stadef int32 = int32_0 // 1st-select
stadef Int32 = [i:int] int32_1 (i)
//
tkindef
uint32_kind = "atstype_uint32"
typedef
uint32_0 = g0uint (uint32_kind)
typedef
uint32_1
  (i:int) = g1uint (uint32_kind, i)
//
stadef uint32 = uint32_1 // 2nd-select
stadef uint32 = uint32_0 // 1st-select
stadef uInt32 = [i:nat] uint32_1 (i)
//
(* ****** ****** *)
//
tkindef
int64_kind = "atstype_int64"
typedef
int64_0 = g0int (int64_kind)
typedef
int64_1
  (i:int) = g1int (int64_kind, i)
//
stadef int64 = int64_1 // 2nd-select
stadef int64 = int64_0 // 1st-select
stadef Int64 = [i:int] int64_1 (i)
//
tkindef
uint64_kind = "atstype_uint64"
typedef
uint64_0 = g0uint (uint64_kind)
typedef
uint64_1
  (i:int) = g1uint (uint64_kind, i)
//
stadef uint64 = uint64_1 // 2nd-select
stadef uint64 = uint64_0 // 1st-select
stadef uInt64 = [i:nat] uint64_1 (i)
//
(* ****** ****** *)
//
abst@ype
g0float_t0ype (tk:tk) = tkind_t0ype (tk)
stadef g0float = g0float_t0ype // shorthand
//
tkindef float_kind = "atstype_float"
typedef float = g0float (float_kind)
//
tkindef double_kind = "atstype_double"
typedef double = g0float (double_kind)
//
tkindef ldouble_kind = "atstype_ldouble"
typedef ldouble = g0float (ldouble_kind)
//
(* ****** ****** *)
//
// HX: unindexed type for pointers
//
tkindef ptr_kind = "atstype_ptrk"
//
abstype ptr_type = tkind_type(ptr_kind)
abstype ptr_addr_type(l:addr) = ptr_type
//
typedef ptr = ptr_type // HX: a shorthand
typedef ptr(l:addr) = ptr_addr_type(l) // HX: a shorthand
//
typedef Ptr = [l:addr] ptr(l)
typedef Ptr0 = [l:agez] ptr(l)
typedef Ptr1 = [l:addr|l > null] ptr(l)
//
typedef
Ptrnull (l:addr) =
  [l1:addr | l1 == null || l1 == l] ptr(l1)
// end of [Ptrnull]
//
// HX-2012-02-14: it is an expriment for now:
//
typedef ptr(n:int) = ptr_addr_type(addr_of_int(n))
//
(* ****** ****** *)

(*
** HX: persistent read-only strings
*)
(*
//
// HX-2013-04: this confuses type-erasure
//
abstype
string_type = $extype"atstype_string"
*)
abstype
string_type = ptr // = char* in C
abstype
string_int_type(n: int) = string_type
//
stadef
string0 = string_type
stadef
string1 = string_int_type
//
stadef string = string1 // 2nd-select
stadef string = string0 // 1st-select
//
typedef String = [n:int] string_int_type(n)
typedef String0 = [n:int | n >= 0] string_int_type(n)
typedef String1 = [n:int | n >= 1] string_int_type(n)
//
(* ****** ****** *)
//
abstype
stropt_int_type(n:int) = ptr
//
typedef
stropt(n:int) = stropt_int_type(n)
//
typedef stropt = [n:int] stropt_int_type(n)
typedef Stropt = [n:int] stropt_int_type(n)
typedef Stropt0 = [n:int] stropt_int_type(n)
typedef Stropt1 = [n:int | n >= 0] stropt_int_type(n)
//
(* ****** ****** *)
//
(*
** HX: linear mutable strings
*)
//
absvtype
strptr_addr_vtype(l:addr) = ptr
vtypedef strptr(l:addr) = strptr_addr_vtype(l)
//
vtypedef strptr = [l:addr] strptr(l)
vtypedef Strptr = [l:addr] strptr(l)
vtypedef Strptr0 = [l:addr] strptr(l)
vtypedef Strptr1 = [l:addr|l > null] strptr(l)
//
absvtype
strnptr_addr_int_vtype(l:addr, n:int) = ptr
vtypedef
strnptr(l:addr, n:int) = strnptr_addr_int_vtype(l, n)
vtypedef
strnptr(n:int) = [l:addr] strnptr_addr_int_vtype(l, n)
//
vtypedef Strnptr = [l:addr;n:int] strnptr(l, n)
vtypedef Strnptr0 = [l:addr;n:int] strnptr(l, n)
vtypedef Strnptr1 = [l:addr;n:int | n >= 0] strnptr(l, n)
//
(* ****** ****** *)

(*
** HX: persistent mutable strings
*)
abstype
strref_addr_type (l:addr) = ptr
stadef strref = strref_addr_type
typedef Strref0 = [l:addr] strref (l)
typedef Strref1 = [l:addr | l > null] strref (l)

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

abst@ype
atsvoid_t0ype
(*
= $extype"atsvoid_t0ype"
*)
typedef void = atsvoid_t0ype // = C-void

(* ****** ****** *)
//
absvtype
exception_vtype = $extype"atstype_exnconptr"
//
vtypedef exn = exception_vtype // boxed vtype
//
(* ****** ****** *)

absvt@ype // covariance
opt_vt0ype_bool_vt0ype (a:vt@ype+, opt:bool) = a
stadef opt = opt_vt0ype_bool_vt0ype

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

typedef bytes (n:int) = @[byte][n]
viewdef bytes_v (l:addr, n:int) = bytes (n) @ l
typedef b0ytes (n:int) = @[byte?][n]
viewdef b0ytes_v (l:addr, n:int) = b0ytes (n) @ l

(* ****** ****** *)
//
abstype
cloref_t0ype_type (a:t@ype) = ptr
stadef cloref = cloref_t0ype_type
//
absvtype
cloptr_vt0ype_vtype (a:t@ype) = ptr
stadef cloptr = cloptr_vt0ype_vtype
vtypedef
cloptr0 = cloptr_vt0ype_vtype (void)
//
(* ****** ****** *)
//
typedef
stamped_t
  (a:t@ype) = [x:int] stamped_t(a, x)
//
vtypedef
stamped_vt
  (a:vt@ype) = [x:int] stamped_vt(a, x)
//
(* ****** ****** *)
//
// HX:
// for memory deallocation
// (with GC and without GC)
//
absview
mfree_gc_addr_view(addr)
stadef
mfree_gc_v = mfree_gc_addr_view
//
absview
mfree_ngc_addr_view(addr)
stadef
mfree_ngc_v = mfree_ngc_addr_view
//
absview
mfree_libc_addr_view(addr) // libc-mfree
stadef
mfree_libc_v = mfree_libc_addr_view
//
(* ****** ****** *)
//
absvt@ype
arrpsz_vt0ype_int_vt0ype
  (a:vt@ype+, n:int) = $extype"atstype_arrpsz"
//
stadef
arrpsz = arrpsz_vt0ype_int_vt0ype
//
(* ****** ****** *)

absprop // invariance
vbox_view_prop (v:view)
propdef
vbox(v:view) = vbox_view_prop(v)

abstype // invariance
ref_vt0ype_type(a:vt@ype) = ptr
typedef
ref(a:vt@ype) = ref_vt0ype_type(a)

(* ****** ****** *)
//
viewdef
vtakeout
( v1: view
, v2: view ) = (v2, v2 -<lin,prf> v1)
viewdef
vtakeout0 (v:view) = vtakeout(void, v)
//
vtypedef
vttakeout
( vt1:vt@ype
, vt2:vt@ype ) = (vt2 -<lin,prf> vt1 | vt2)
vtypedef
vttakeout0 (vt:vt@ype) = vttakeout(void, vt)
//
(* ****** ****** *)
//
vtypedef
vtakeoutptr
  (a:vt@ype) =
  [l:addr] (a@l, a@l -<lin,prf> void | ptr l)
//
(* ****** ****** *)
//
vtypedef
vstrptr(l:addr) = vttakeout0(strptr(l))
//
vtypedef vStrptr0 = [l:agez] vstrptr(l)
vtypedef vStrptr1 = [l:addr | l > null] vstrptr(l)
//
(* ****** ****** *)

typedef
bottom_t0ype_uni = {a:t@ype} (a)
typedef
bottom_t0ype_exi = [a:t@ype | false] (a)

vtypedef
bottom_vt0ype_uni = {a:vt@ype} (a)
vtypedef
bottom_vt0ype_exi = [a:vt@ype | false] (a)

(* ****** ****** *)
//
typedef
cmpval_fun
  (a: t@ype) = (a, a) -<fun> int
typedef
cmpval_funenv
  (a: t@ype, vt: t@ype) = (a, a, !vt) -<fun> int
//
stadef cmpval = cmpval_fun and cmpval = cmpval_funenv
//
(* ****** ****** *)
//
typedef
cmpref_fun
  (a: vt@ype) = (&RD(a), &RD(a)) -<fun> int
typedef
cmpref_funenv
  (a: vt@ype, vt: vt@ype) = (&RD(a), &RD(a), !vt) -<fun> int
//
stadef cmpref = cmpref_fun and cmpref = cmpref_funenv
//
(* ****** ****** *)
//
// HX: [lazy(T)] :
// suspended evaluation of type T
//
abstype
lazy_t0ype_type(t@ype+) = ptr
typedef
lazy(a:t@ype) = lazy_t0ype_type(a)
//
(* ****** ****** *)
//
// HX: [lazy_vt(VT)] :
// suspended computation of viewtype VT
//
absvtype
lazy_vt0ype_vtype(vt@ype+) = ptr
vtypedef
lazy_vt(a:vt@ype) = lazy_vt0ype_vtype(a)
//
(* ****** ****** *)
//
(*
//
// HX-2016-02-21:
// these are renamed/relocated elsewhere
//
// HX-2017-10-03:
// Is this even needed? Parsing works but
// $literal(...) does not seem to be in use
// Please see $PATSHOME/utils/atexting/TEST
//
(*
abst0ype
literal_int(intlit) = $extype"atsliteral_int"
*)
//
(*
abst0ype
literal_float(float) = $extype"atsliteral_float"
*)
//
(*
abst0ype
literal_string(string) = $extype"atsliteral_string"
*)
//
*)
//
(* ****** ****** *)
//
abst@ype
undefined_t0ype = $extype"atstype_undefined"
absvt@ype
undefined_vt0ype = $extype"atstype_undefined"
//
(* ****** ****** *)

#if VERBOSE_PRELUDE #then
#print "Loading [basics_sta.sats] finishes!\n"
#endif // end of [VERBOSE_PRELUDE]

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

(* end of [basics_sta.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2013 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

(* ****** ****** *)
//
// Author of the file:
// Hongwei Xi (gmhwxiATgmailDOTcom)
// Start Time: September, 2011
//
(* ****** ****** *)

#include "prelude/params.hats"

(* ****** ****** *)
//
fun
patsopt_version(): string = "ext#%"
//
(* ****** ****** *)

#if VERBOSE_PRELUDE #then
#print "Loading [basics_dyn.sats] starts!\n"
#endif // end of [VERBOSE_PRELUDE]

(* ****** ****** *)
//
sortdef t0p = t@ype and vt0p = vt@ype
//
(* ****** ****** *)

datatype TYPE(a:vt@ype) = TYPE(a) of ()

(* ****** ****** *)
//
// HX-2012: In $ATSHOME/ccomp/runtime:
// atsbool_true/atsbool_false are mapped to 1/0
// this mapping is fixed and should never be changed!
//
#define true true_bool // shorthand
#define false false_bool // shorthand
//
val true_bool : bool(true)  = "mac#atsbool_true" // = 1
val false_bool : bool(false) = "mac#atsbool_false" // = 0
//
(* ****** ****** *)
//
// HX: [false] implies all
//
prfun false_elim{X:prop | false} ((*void*)): X
//
(* ****** ****** *)
//
typedef
compopr_type(a: t@ype) = (a, a) -<fun0> bool
typedef
compare_type(a: t@ype) = (a, a) -<fun0> int(*-/0/+*)
//
(* ****** ****** *)
//
praxi
lemma_subcls_reflexive
  {c:cls}((*void*)): [c <= c] void
//
praxi
lemma_subcls_transitive
  {c1,c2,c3:cls | c1 <= c2; c2 <= c3}(): [c1 <= c3] void
//
(* ****** ****** *)
//
praxi
praxi_int{i:int} ((*void*)): int(i)
//
dataprop
MUL_prop
(
  int, int, int
) = // MUL_prop
  | {n:int}
    MULbas (0, n, 0)
  | {m:nat}{n:int}{p:int}
    MULind (m+1, n, p+n) of MUL_prop (m, n, p)
  | {m:pos}{n:int}{p:int}
    MULneg (~(m), n, ~(p)) of MUL_prop (m, n, p)
//
propdef MUL(m:int, n:int, mn:int) = MUL_prop(m, n, mn)
//
(* ****** ****** *)
//
// HX-2010-12-30: 
//
absprop
DIVMOD (
  x:int, y: int, q: int, r: int // x = q * y + r
) // end of [DIVMOD]
//
propdef DIV (x:int, y:int, q:int) = [r:int] DIVMOD(x, y, q, r)
propdef MOD (x:int, y:int, r:int) = [q:int] DIVMOD(x, y, q, r)
//
(* ****** ****** *)

dataprop
EQINT(int, int) = {x:int} EQINT(x, x)
//
prfun
eqint_make{x,y:int | x == y}(): EQINT(x, y)
//
prfun
eqint_make_gint
  {tk:tk}{x:int}(x: g1int(tk, x)): [y:int] EQINT(x, y)
prfun
eqint_make_guint
  {tk:tk}{x:int}(x: g1uint(tk, x)): [y:int] EQINT(x, y)
//
(* ****** ****** *)

praxi praxi_ptr{l:addr} ((*void*)): ptr(l)
praxi praxi_bool{b:bool} ((*void*)): bool(b)

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

dataprop
EQADDR(addr, addr) = {x:addr} EQADDR(x, x)
//
prfun
eqaddr_make{x,y:addr | x == y}(): EQADDR(x, y)
//
prfun
eqaddr_make_ptr{x:addr}(x: ptr(x)): [y:addr] EQADDR(x, y)
//
(* ****** ****** *)

dataprop
EQBOOL(bool, bool) = {x:bool} EQBOOL(x, x)
//
prfun
eqbool_make{x,y:bool | x == y}(): EQBOOL(x, y)
//
prfun
eqbool_make_bool{x:bool}(x: bool(x)): [y:bool] EQBOOL(x, y)
//
(* ****** ****** *)
//
dataprop
EQTYPE(vt@ype, vt@ype) = {a:vt@ype} EQTYPE (a, a)
//
(* ****** ****** *)

prfun
prop_verify{b:bool | b} ():<prf> void
prfun
prop_verify_and_add{b:bool | b} ():<prf> [b] void

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

prfun pridentity_v{v:view} (x: !INV(v)): void
prfun pridentity_vt{vt:viewt@ype} (x: !INV(vt)): void

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

castfn
viewptr_match
{a:vt0ype}{l1,l2:addr|l1==l2}
(
  pf: INV(a) @ l1 | p: ptr(l2)
) :<> [l:addr | l==l1] (a @ l | ptr(l))
// end of [viewptr_match]

(* ****** ****** *)
//
val{
a:vt0ype
} sizeof : size_t(sizeof(a))
//
praxi
lemma_sizeof
  {a:vt0ype}((*void*)): [sizeof(a) >= 0] void
//
(* ****** ****** *)

praxi topize{a:t0ype} (x: !INV(a) >> a?): void

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

castfn dataget{a:vt0ype} (x: !INV(a) >> a): a?!

(* ****** ****** *)
//
// HX: returning the pf to GC
//
praxi
mfree_gc_v_elim
  {l:addr} (pf: mfree_gc_v l):<prf> void
// end of [mfree_gc_v_elim]

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

praxi
mfree_gcngc_v_nullify
  {l:addr} (
  pf1: mfree_gc_v(l), pf1: mfree_ngc_v(l)
) : void // end of [mfree_gcngc_nullify_v]

(* ****** ****** *)
//
fun
cloptr_free
  {a:t0p}
  (pclo: cloptr(a)):<!wrt> void = "mac#%"
//
(* ****** ****** *)
//
fun
{a:t0p}
lazy_force(lazyval: lazy(INV(a))):<!laz> (a)
//
fun
{a:vt0p}
lazy_vt_force(lazyval: lazy_vt(INV(a))):<!all> (a)
//
(*
//
// HX-2016-08:
// this is assumed internally!
//
overload ! with lazy_force of 0
overload ! with lazy_vt_force of 0
*)
//
(* ****** ****** *)
//
// HX-2013:
// macro implemented in [pats_ccomp_instrset]
//
fun
lazy_vt_free
  {a:vt0p}
  (lazyval: lazy_vt(a)):<!wrt> void = "mac#%"
//
overload ~ with lazy_vt_free of 0
//
(* ****** ****** *)
//
// HX-2014:
// macro implemented in [pats_ccomp_instrset]
//
fun
lazy2cloref
  {a:t0p}(lazy(a)): ((*void*)) -<cloref1> (a) = "mac#%"
//
(* ****** ****** *)

(*
// HX-2012-05-23: this seems TOO complicated!
(*
** HX-2012-03: handling read-only views and vtypes
*)
castfn
read_getval // copy out a non-linear value
  {a:t@ype}{s:int}{n:int} (x: !READ (a, s, n)):<> a
// end of [read_getval]

praxi
read_takeout{v:view}
  (pf: !v >> READOUT (v, s)): #[s:int] READ (v, s, 0)
// end of [read_takeout]
praxi
read_addback // HX: there is no need to check
  {v1:view}{v2:view}{s:int} // if v1 and v2 match
  (pf1: !READOUT (v1, s) >> v1, pf2: READ (v2, s, 0)): void
// end of [read0_addback]

praxi
read_split
  {v:view}{s:int}{n:int}
  (pf: !READ (v, s, n) >> READ (v, s, n+1)): READ (v, s, 0)
// end of [read_split]
praxi
read_unsplit // HX: there is no need to check
  {v1:view}{v2:view}{s:int}{n1,n2:int} // if v1 and v2 match
  (pf1: READ (v1, s, n1), pf2: READ (v2, s, n2)): READ (v1, s, n1+n2-1)
// end of [read_unsplit]
*)
(* ****** ****** *)
//
castfn
stamp_t{a:t@ype}(x: a):<> stamped_t(a)
castfn
stamp_vt{a:vt@ype}(x: a):<> stamped_vt(a)
//
(* ****** ****** *)

castfn
unstamp_t
  {a:t@ype}{x:int}(x: stamped_t(INV(a), x)):<> a
// end of [unstamp_t]
castfn
unstamp_vt
  {a:vt@ype}{x:int}(x: stamped_vt(INV(a), x)):<> a
// end of [unstamp_vt]

(* ****** ****** *)
//
castfn
stamped_t2vt
  {a:t@ype}{x:int}
  (x: stamped_t(INV(a), x)):<> stamped_vt(a, x)
// end of [stamped_t2vt]
//
castfn
stamped_vt2t
  {a:t@ype}{x:int}
  (x: stamped_vt(INV(a), x)):<> stamped_t(a, x)
// end of [stamped_vt2t]
//
fun{a:t@ype}
stamped_vt2t_ref{x:int}
  (x: &stamped_vt(INV(a), x)):<> stamped_t(a, x)
//
(* ****** ****** *)
//
praxi
vcopyenv_v_decode
  {v:view}(x: vcopyenv_v(v)): vtakeout0(v)
castfn
vcopyenv_vt_decode
  {vt:vt0p}(x: vcopyenv_vt(vt)): vttakeout0(vt)
//
overload decode with vcopyenv_v_decode
overload decode with vcopyenv_vt_decode
//
(* ****** ****** *)
//
// HX: the_null_ptr = (void*)0
//
val
the_null_ptr
  : ptr(null) = "mac#the_atsptr_null"
//
(* ****** ****** *)
//
praxi
lemma_addr_param
  {l:addr}((*void*)): [l >= null] void
//
(* ****** ****** *)

praxi
lemma_string_param
  {n:int} (x: string(n)): [n >= 0] void
// end of [lemma_string_param]
praxi
lemma_stropt_param
  {n:int} (x: stropt(n)): [n >= ~1] void
// end of [lemma_stropt_param]

(* ****** ****** *)
//
dataprop
SGN (int, int) =
  | SGNzero (0, 0)
  | {i:neg} SGNneg (i, ~1) | {i:pos} SGNpos (i,  1)
// end of [SGN] // end of [dataprop]
//
(* ****** ****** *)
//
// HX-2012-06:
// indication of the failure of
exception AssertExn of () // an assertion
//
(* ****** ****** *)
//
// HX-2012-06:
// indication of something expected
exception NotFoundExn of () // to be found but not
//
(* ****** ****** *)
//
exception GenerallyExn of (string) // for unspecified causes
(*
exception GenerallyExn2 of (string, ptr(*data*)) // for unspecified causes
*)
//
(* ****** ****** *)
//
// HX-2012-07:
// indication of a function argument being
exception IllegalArgExn of (string) // out of its domain
//
(* ****** ****** *)

praxi __vfree_exn (x: exn):<> void // for freeing nullary exception-con

(* ****** ****** *)
//
datatype unit = unit of ()
dataprop unit_p = unit_p of ()
dataview unit_v = unit_v of ()
datavtype unit_vt = unit_vt of ()
//
prfun unit_v_elim (pf: unit_v): void
//
(* ****** ****** *)
//
abstype
boxed_t0ype_type(a:t@ype+) = unit
absvtype
boxed_vt0ype_vtype(a:vt@ype+) = unit
//
vtypedef
boxed(a:vt@ype) = boxed_vt0ype_vtype(a)
vtypedef
boxed_vt(a:vt@ype) = boxed_vt0ype_vtype(a)
//
typedef boxed(a:t@ype) = boxed_t0ype_type(a)
typedef boxed_t(a:t@ype) = boxed_t0ype_type(a)
//
fun{a:type} box: (INV(a)) -> boxed_t(a)
fun{a:type} unbox: boxed_t(INV(a)) -> (a)
fun{a:vtype} box_vt: (INV(a)) -> boxed_vt(a)
fun{a:vtype} unbox_vt: boxed_vt(INV(a)) -> (a)
//
(* ****** ****** *)
//
stadef
array(a:vt@ype, n:int) = @[a][n]
//
viewdef
array_v
  (a:vt@ype, l:addr, n:int) = @[a][n] @ l
//
absvtype
arrayptr_vt0ype_addr_int_vtype
  (a:vt0ype+, l:addr, n:int(*size*)) = ptr(l)
stadef
arrayptr = arrayptr_vt0ype_addr_int_vtype
vtypedef
arrayptr
  (a:vt0p, n:int) = [l:addr] arrayptr(a, l, n)
//
abstype
arrayref_vt0ype_int_type
  (a:vt@ype(*elt*), n:int(*size*)) = ptr
stadef arrayref = arrayref_vt0ype_int_type
//
abstype
arrszref_vt0ype_type(a: vt@ype) = ptr
typedef arrszref(a:vt0p) = arrszref_vt0ype_type(a)
//
(* ****** ****** *)
//
datatype
// t@ype+: covariant
list_t0ype_int_type
  (a:t@ype+, int) =
  | list_nil(a, 0) of ()
  | {n:int | n >= 0}
    list_cons(a, n+1) of (a, list_t0ype_int_type(a, n))
// end of [datatype]
stadef list = list_t0ype_int_type
typedef
List(a:t0p) = [n:int] list(a, n)
typedef
List0(a:t0p) = [n:int | n >= 0] list(a, n)
typedef
List1(a:t0p) = [n:int | n >= 1] list(a, n)
typedef listLt
  (a:t0p, n:int) = [k:nat | k < n] list(a, k)
typedef listLte
  (a:t0p, n:int) = [k:nat | k <= n] list(a, k)
typedef listGt
  (a:t0p, n:int) = [k:int | k > n] list(a, k)
typedef listGte
  (a:t0p, n:int) = [k:int | k >= n] list(a, k)
typedef listBtw
  (a:t0p, m:int, n:int) = [k:int | m <= k; k < n] list(a, k)
typedef listBtwe
  (a:t0p, m:int, n:int) = [k:int | m <= k; k <= n] list(a, k)
//
(* ****** ****** *)
//
datavtype
// vt@ype+: covariant
list_vt0ype_int_vtype
  (a:vt@ype+, int) =
  | list_vt_nil(a, 0) of ()
  | {n:int | n >= 0}
    list_vt_cons(a, n+1) of (a, list_vt0ype_int_vtype(a, n))
// end of [list_vt0ype_int_vtype]
stadef list_vt = list_vt0ype_int_vtype
vtypedef
List_vt(a:vt0p) = [n:int] list_vt(a, n)
vtypedef
List0_vt(a:vt0p) = [n:int | n >= 0] list_vt(a, n)
vtypedef
List1_vt(a:vt0p) = [n:int | n >= 1] list_vt(a, n)
vtypedef listLt_vt
  (a:vt0p, n:int) = [k:nat | k < n] list_vt(a, k)
vtypedef listLte_vt
  (a:vt0p, n:int) = [k:nat | k <= n] list_vt(a, k)
vtypedef listGt_vt
  (a:vt0p, n:int) = [k:int | k > n] list_vt(a, k)
vtypedef listGte_vt
  (a:vt0p, n:int) = [k:int | k >= n] list_vt(a, k)
vtypedef listBtw_vt
  (a:vt0p, m:int, n:int) = [k:int | m <= k; k < n] list_vt(a, k)
vtypedef listBtwe_vt
  (a:vt0p, m:int, n:int) = [k:int | m <= k; k <= n] list_vt(a, k)
//
(* ****** ****** *)
//
datatype
stream_con(a:t@ype+) =
  | stream_nil of ((*void*))
  | stream_cons of (a, stream(a))
//
where stream (a:t@ype) = lazy (stream_con(a))
//
datavtype
stream_vt_con
  (a:vt@ype+) =
  | stream_vt_nil of ((*void*))
  | stream_vt_cons of (a, stream_vt(a))
//
where
stream_vt(a:vt@ype) = lazy_vt(stream_vt_con(a))
//
(* ****** ****** *)
//
datatype
// t@ype+: covariant
option_t0ype_bool_type
(
  a:t@ype+, bool
) = // option_t0ype_bool_type
  | Some(a, true) of (INV(a)) | None(a, false)
// end of [datatype]
stadef option = option_t0ype_bool_type
typedef Option(a:t0p) = [b:bool] option(a, b)
//
datavtype
// vt@ype+: covariant
option_vt0ype_bool_vtype
(
  a:vt@ype+, bool
) = // option_vt0ype_bool_vtype
  | Some_vt(a, true) of (INV(a)) | None_vt(a, false)
// end of [option_vt0ype_bool_vtype]
stadef option_vt = option_vt0ype_bool_vtype
vtypedef Option_vt(a:vt0p) = [b:bool] option_vt(a, b)
//
(* ****** ****** *)
//
praxi
opt_some{a:vt0p}
  (x: !INV(a) >> opt(a, true)):<prf> void
praxi
opt_unsome{a:vt0p}
  (x: !opt(INV(a), true) >> a):<prf> void
//
fun{a:vt0p}
opt_unsome_get(x: &opt(INV(a), true) >> a?): (a)
//
praxi
opt_none{a:vt0p}
  (x: !(a?) >> opt(a, false)):<prf> void
praxi
opt_unnone{a:vt0p}
  (x: !opt(INV(a), false) >> a?):<prf> void
//
praxi
opt_clear{a:t0p}
  {b:bool}(x: !opt(INV(a), b) >> a?):<prf> void
//
(* ****** ****** *)
//
dataprop
or_prop_prop_int_prop
(
  a0: prop+, a1: prop+, int
) = // or_prop_prop_int_prop
  | POR_l(a0, a1, 0) of (INV(a0))
  | POR_r(a0, a1, 1) of (INV(a1))
dataview
or_view_view_int_view
(
  a0: view+, a1: view+, int
) = // or_view_view_int_view
  | VOR_l(a0, a1, 0) of (INV(a0))
  | VOR_r(a0, a1, 1) of (INV(a1))
//
stadef por = or_prop_prop_int_prop
stadef vor = or_view_view_int_view
//
dataprop
option_prop_bool_prop
(
  a:prop+, bool
) = // option_prop_bool_prop
  | Some_p (a, true) of (INV(a)) | None_p (a, false)
// end of [option_prop_bool_prop]
stadef option_p = option_prop_bool_prop
//
dataview
option_view_bool_view
  (a:view+, bool) =
  | Some_v (a, true) of (INV(a)) | None_v (a, false)
// end of [option_view_bool_view]
stadef option_v = option_view_bool_view
//
(* ****** ****** *)
//
absvt@ype
arrayopt(a:vt0p, n:int, b:bool) = array(a, n)
//
praxi
arrayopt_some
  {a:vt0p}{n:int}
  (A: &array(a, n) >> arrayopt(a, n, true)): void
praxi
arrayopt_none
  {a:vt0p}{n:int}
  (A: &array(a?, n) >> arrayopt(a, n, false)): void
praxi
arrayopt_unsome
  {a:vt0p}{n:int}
  (A: &arrayopt(a, n, true) >> array(a, n)): void
praxi
arrayopt_unnone
  {a:vt0p}{n:int}
  (A: &arrayopt(a, n, false) >> array(a?, n)): void
//
(* ****** ****** *)

absvtype
argv_int_vtype (n:int) = ptr
stadef argv = argv_int_vtype

(*
[argv_takeout_strarr] is declared in prelude/SATS/extern.sats
[argv_takeout_parrnull] is declared in prelude/SATS/extern.sats
*)

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

praxi
lemma_argv_param
  {n:int}(argv: !argv(n)): [n >= 0] void
// end of [praxi]

(* ****** ****** *)
//
fun
argv_get_at{n:int}
  (argv: !argv(n), i: natLt(n)):<> string = "mac#%"
fun
argv_set_at{n:int}
  (argv: !argv(n), i: natLt(n), x: string):<!wrt> void = "mac#%"
//
overload [] with argv_get_at
overload [] with argv_set_at
//
(* ****** ****** *)
//
fun{}
listize_argc_argv
  {n:int}
  (argc: int(n), argv: !argv(n)): list_vt(string, n)
//
(* ****** ****** *)
//
symintr main0
//
fun
main_void_0
(
  (*void*)
) : void = "ext#mainats_void_0"
fun
main_argc_argv_0
  {n:int | n >= 1}
  (argc: int n, argv: !argv(n)): void = "ext#mainats_argc_argv_0"
//
overload main0 with main_void_0
overload main0 with main_argc_argv_0
//
(* ****** ****** *)
//
symintr main
//
fun
main_void_int
(
  (*void*)
) : int = "ext#mainats_void_int"
fun
main_argc_argv_int
  {n:int | n >= 1}
  (argc: int n, argv: !argv(n)): int = "ext#mainats_argc_argv_int"
fun
main_argc_argv_envp_int
  {n:int | n >= 1}
  (argc: int n, argv: !argv n, envp: ptr): int = "ext#mainats_argc_argv_envp_int"
//
overload main with main_void_int
overload main with main_argc_argv_int
overload main with main_argc_argv_envp_int
//
(* ****** ****** *)
//
fun
exit(ecode: int):<!exn> {a:t0p}(a) = "mac#%"
fun
exit_errmsg
  (ecode: int, msg: string):<!exn> {a:t0p}(a) = "mac#%"
//
(*
fun exit_fprintf{ts:types}
(
  ecode: int, out: FILEref, fmt: printf_c ts, args: ts
) :<!exn> {a:vt0p}(a) = "mac#%" // end of [exit_fprintf]
*)
//
(* *****p* ****** *)
//
fun
exit_void
  (ecode: int):<!exn> void = "mac#%"
fun
exit_errmsg_void
  (ecode: int, msg: string):<!exn> void = "mac#%"
//
(* ****** ****** *)
//
fun
assert_bool0
  (x: bool):<!exn> void = "mac#%"
fun
assert_bool1
  {b:bool} (x: bool (b)):<!exn> [b] void = "mac#%"
//
overload assert with assert_bool0 of 0
overload assert with assert_bool1 of 10
//
(* ****** ****** *)
//
fun{}
assertexn_bool0 (x: bool):<!exn> void
fun{}
assertexn_bool1 {b:bool} (x: bool (b)):<!exn> [b] void
//
symintr assertexn
overload assertexn with assertexn_bool0 of 0
overload assertexn with assertexn_bool1 of 10
//
(* ****** ****** *)
//
fun
assert_errmsg_bool0
  (x: bool, msg: string):<!exn> void = "mac#%"
fun
assert_errmsg_bool1
  {b:bool} (x: bool b, msg: string):<!exn> [b] void = "mac#%"
//
symintr assert_errmsg
overload assert_errmsg with assert_errmsg_bool0 of 0
overload assert_errmsg with assert_errmsg_bool1 of 10
//
(* ****** ****** *)
//
fun
assert_errmsg2_bool0
  (x: bool, msg1: string, msg2: string):<!exn> void = "mac#%"
fun
assert_errmsg2_bool1{b:bool}
  (x: bool b, msg1: string, msg2: string):<!exn> [b] void = "mac#%"
//
symintr assert_errmsg2
overload assert_errmsg2 with assert_errmsg2_bool0 of 0
overload assert_errmsg2 with assert_errmsg2_bool1 of 10
//
(* ****** ****** *)
//
datasort
file_mode =
  | file_mode_r (* read *)
  | file_mode_w (* write *)
  | file_mode_rw (* read and write *)
// end of [file_mode]
//
(* ****** ****** *)

local
//
stadef r() = file_mode_r()
stadef w() = file_mode_w()
stadef rw() = file_mode_rw()
//
in (* in-of-local *)

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

abstype
file_mode (file_mode) = string
typedef
file_mode = [fm:file_mode] file_mode (fm)

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

sortdef fmode = file_mode
typedef fmode (fm:fmode) = file_mode (fm)
typedef fmode = file_mode

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

dataprop
file_mode_lte
  (fmode, fmode) =
//
  | {m:fmode} file_mode_lte_refl (m, m)
//
  | {m1,m2,m3:fmode}
    file_mode_lte_tran (m1, m3) of
    (file_mode_lte(m1, m2), file_mode_lte(m2, m3))
//
  | {m:fmode} file_mode_lte_rw_r(rw(), r()) of ()
  | {m:fmode} file_mode_lte_rw_w(rw(), w()) of ()
// end of [file_mode_lte]

(* ****** ****** *)
//
prval
file_mode_lte_r_r
  : file_mode_lte(r(), r()) // impled in [filebas_prf.dats]
prval
file_mode_lte_w_w
  : file_mode_lte(w(), w()) // impled in [filebas_prf.dats]
prval
file_mode_lte_rw_rw
  : file_mode_lte(rw(), rw()) // impled in [filebas_prf.dats]
//
(* ****** ****** *)

end // end of [local]

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

abstype FILEref_type = ptr
typedef FILEref = FILEref_type

(* ****** ****** *)
//
typedef
print_type(a: t0p) = (a) -> void
typedef
prerr_type(a: t0p) = (a) -> void
typedef
fprint_type(a: t0p) = (FILEref, a) -> void
//
typedef
print_vtype(a: vt0p) = (!a) -> void
typedef
prerr_vtype(a: vt0p) = (!a) -> void
typedef
fprint_vtype(a: vt0p) = (FILEref, !a) -> void
//
(* ****** ****** *)

(*
fun print_void(x: void): void = "mac#%"
*)

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

fun print_newline((*void*)): void = "mac#%"
fun prerr_newline((*void*)): void = "mac#%"
fun fprint_newline(out: FILEref): void = "mac#%"

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

#if VERBOSE_PRELUDE #then
#print "Loading [basics_dyn.sats] finishes!\n"
#endif // end of [VERBOSE_PRELUDE]

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

(* end of [basics_dyn.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2013 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

(* ****** ****** *)
//
// Author of the file:
// Hongwei Xi (gmhwxiATgmailDOTcom)
// Start Time: July, 2012
//
(* ****** ****** *)

#include "prelude/params.hats"

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

#if VERBOSE_PRELUDE #then
#print "Loading [basics_gen.sats] starts!\n"
#endif // end of [VERBOSE_PRELUDE]

(* ****** ****** *)
//
fun
{a:t0p}
gidentity (x: INV(a)):<> a
//
fun
{a:vt0p}
gidentity_vt (x: INV(a)):<> a
//
(* ****** ****** *)
//
fun
{a:vt0p}
gcopy_val (x: !INV(a)):<!wrt> a
//
fun
{a:vt0p}
gcopy_ref (x: &INV(a)):<!wrt> a
//
(* ****** ****** *)
//
fun
{a:vt0p}
gfree_val (x: INV(a)):<!wrt> void
//
(*
fun
{a:vt0p}
gfree_ref (x: &INV(a) >> a?):<!wrt> void
*)
//
(* ****** ****** *)

fun
{a:vt0p}
ginit_ref (x: &a? >> a):<!wrt> void

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

fun
{a:vt0p}
gclear_ref (x: &a >> a?):<!wrt> void

(* ****** ****** *)
//
fun
{a:t0p}
gequal_val_val (x: a, y: a):<> bool
//
fun
{a:vt0p}
gequal_ref_ref (x: &INV(a), y: &a):<> bool
//
(* ****** ****** *)

fun{a:t0p}
tostring_val (x: a):<> string
fun{a:vt0p}
tostring_ref (x: &INV(a)):<> string

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

fun{a:t0p}
tostrptr_val (x: a):<!wrt> Strptr1
fun{a:vt0p}
tostrptr_ref (x: &INV(a)):<!wrt> Strptr1

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

(*
//
fun{a:t0p}
print_val (x: a): void // = fprint_val (stdout_ref, x)
fun{a:t0p}
prerr_val (x: a): void // = fprint_val (stderr_ref, x)
//
fun{a:vt0p}
print_ref (x: &INV(a)): void // = fprint_ref (stdout_ref, x)
fun{a:vt0p}
prerr_ref (x: &INV(a)): void // = fprint_ref (stderr_ref, x)
//
*)

(* ****** ****** *)
//
fun{a:t0p}
fprint_val (out: FILEref, x: a): void
fun{a:vt0p}
fprint_ref (out: FILEref, x: &INV(a)): void
//
(* ****** ****** *)
//
fun
{src:vt0p}
{elt:vt0p}
streamize_val (source: src): stream_vt(elt)
//
(* ****** ****** *)

#if VERBOSE_PRELUDE #then
#print "Loading [basics_gen.sats] finishes!\n"
#endif // end of [VERBOSE_PRELUDE]

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

(* end of [basics_gen.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2013 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

(* ****** ****** *)
//
// Author of the file:
// Hongwei Xi (gmhwxiATgmailDOTcom)
// Start Time: May, 2012
//
(* ****** ****** *)

#include "prelude/params.hats"

(* ****** ****** *)
//
(*
** HX: short form
*)
//
// [orelse] and [andalso] are declared as infix ops
//
macdef
orelse(x, y) =
  (if ,(x) then true else ,(y)): bool
macdef
andalso(x, y) =
  (if ,(x) then ,(y) else false): bool
//
(* ****** ****** *)
//
macdef
ifval(test, v_then, v_else) =
  (if ,(test) then ,(v_then) else ,(v_else))
//
(* ****** ****** *)
//
macdef delay(exp) = $delay(,(exp))
macdef raise(exn) = $raise(,(exn))
//
(*
macdef effless(exp) = $effmask_all(,(exp))
*)
//
(* ****** ****** *)

macdef assign(lv, rv) = ,(lv) := ,(rv)

(* ****** ****** *)
//
macdef
exitloc(ecode) =
  exit_errmsg (,(ecode), $mylocation)
//
(* ****** ****** *)
//
macdef
assertloc(tf) =
  assert_errmsg (,(tf), $mylocation)
//
(* ****** ****** *)
//
macdef
assertlocmsg
  (tf, msg) =
  assert_errmsg2 (,(tf), $mylocation, ,(msg))
macdef
assertmsgloc
  (tf, msg) =
  assert_errmsg2 (,(tf), ,(msg), $mylocation)
//
(* ****** ****** *)
//
macdef
undefined() = let
//
val () =
assertlocmsg
  (false, ": undefined!!!") in $raise(AssertExn)
//
end // end of [undefined]
//
(* ****** ****** *)

macdef ignoret(x) = let val _ = ,(x) in (*nothing*) end

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

macdef foldret(x) = let val x = ,(x) in fold@ (x); x end

(* ****** ****** *)
//
macdef showtype(x) = $showtype ,(x)
//
macdef showview(x) = pridentity_v ($showtype ,(x))
//
macdef showvtype(x) = pridentity_vt ($showtype ,(x))
macdef showviewtype(x) = pridentity_vt ($showtype ,(x))
//
(* ****** ****** *)

(* end of [macrodef.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2013 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

(* ****** ****** *)
//
// Author of the file:
// Hongwei Xi (gmhwxiATgmailDOTcom)
// Start Time: March, 2013
//
(* ****** ****** *)
//
// HX-2013-03:
// lmacrodef: local macro definitions
//
(* ****** ****** *)
//
macdef :+= (x, a) = let val v = ,(x) in ,(x) := ,(a) + v end
macdef :-= (x, a) = let val v = ,(x) in ,(x) := ,(a) - v end
macdef :*= (x, a) = let val v = ,(x) in ,(x) := ,(a) * v end
macdef :/= (x, a) = let val v = ,(x) in ,(x) := ,(a) / v end
//
(* ****** ****** *)
//
macdef :=+ (x, a) = let val v = ,(x) in ,(x) := v + ,(a) end
macdef :=- (x, a) = let val v = ,(x) in ,(x) := v - ,(a) end
macdef :=* (x, a) = let val v = ,(x) in ,(x) := v * ,(a) end
macdef :=/ (x, a) = let val v = ,(x) in ,(x) := v / ,(a) end
//
(* ****** ****** *)
//
macdef
println(x) = (print(,(x)); print_newline())
macdef
prerrln(x) = (prerr(,(x)); prerr_newline())
//
macdef
fprintln(out, x) = (fprint(,(out), ,(x)); fprint_newline(,(out)))
//
(* ****** ****** *)
(*
//
// HX-2012-08:
//
// this example makes use of recursive macrodef
//
*)
(*
//
local
//
macrodef
rec
auxlist
  (xs, y) =
(
//
if
iscons! (xs)
then `(print ,(car! xs); ,(auxlist (cdr! xs, y))) else y
// end of [if]
//
) (* end of [auxlist] *)
//
in (* in of [local] *)

macdef
print_mac (x) =
,(
  if islist! (x) then auxlist (x, `()) else `(print ,(x))
) (* end of [print_mac] *)

macdef
println_mac (x) =
,(
  if islist! (x)
    then auxlist (x, `(print_newline())) else `(print ,(x); print_newline())
  // end of [if]
) (* end of [println_mac] *)

end // end of [local]
//
*)

(* ****** ****** *)
//
macdef
eqfn(x0) = lam(x) =<cloref1> (,(x0) = x)
macdef
cmpfn(x0) = lam(x) =<cloref1> compare(,(x0), x)
//
(* ****** ****** *)

(* end of [lmacrodef.hats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: gmhwxiATgmailDOTcom *)
(* Start time: September, 2011 *)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/integer.atxt
** Time of generation: Fri Oct 13 04:36:28 2017
*)

(* ****** ****** *)
//
// HX: for unindexed integer types
//
(* ****** ****** *)

sortdef tk = tkind

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

typedef SHR(a:t@ype) = a // for commenting purpose
typedef NSH(a:t@ype) = a // for commenting purpose

(* ****** ****** *)
//
stadef intknd = int_kind
stadef uintknd = uint_kind
//
(* ****** ****** *)
//
fun
{k1
,k2:tk}
g0int2int(x: g0int(k1)):<> g0int(k2)
//
fun
g0int2int_int_int(i0: int):<> int = "mac#%"
//
(* ****** ****** *)
//
// HX-2015-09-20:
// These are implemented in prelude/string.cats:
//
fun
{tk:tk}
g0int2string(g0int(tk)):<!wrt> Strptr1
//
fun
g0int2string_int(i0: int):<!wrt> Strptr1 = "mac#%"
//
(* ****** ****** *)
//
fun{tk:tk}
g0string2int(rep: NSH(string)):<> g0int(tk)
//
fun
g0string2int_int(rep: NSH(string)):<> int = "mac#%"
//
(* ****** ****** *)
//
typedef
g0int_uop_type
  (tk: tk) =
  (g0int(tk)) -<fun0> g0int(tk)
//
(* ****** ****** *)
//
fun
{tk:tk}
g0int_neg : g0int_uop_type(tk)
overload ~ with g0int_neg of 0
overload neg with g0int_neg of 0
//
(* ****** ****** *)
//
fun
{tk:tk}
g0int_abs : g0int_uop_type(tk)
overload abs with g0int_abs of 0
//
(* ****** ****** *)
//
fun
{tk:tk}
g0int_succ : g0int_uop_type(tk)
fun
{tk:tk}
g0int_pred : g0int_uop_type(tk)
//
overload succ with g0int_succ of 0
overload pred with g0int_pred of 0
//
(* ****** ****** *)
//
fun
{tk:tk}
g0int_half : g0int_uop_type(tk)
overload half with g0int_half of 0
//
(*
fun
{tk:tk}
g0int_double : g0int_uop_type(tk)
overload double with g0int_double of 0
*)
//
(* ****** ****** *)

typedef
g0int_aop_type
  (tk: tk) =
(
  g0int(tk)
, g0int(tk)
) -<fun0> g0int (tk)
// end of [g0int_aop_type]

fun
{tk:tk}
g0int_add : g0int_aop_type(tk)
overload + with g0int_add of 0
fun
{tk:tk}
g0int_sub : g0int_aop_type(tk)
overload - with g0int_sub of 0
fun
{tk:tk}
g0int_mul : g0int_aop_type(tk)
overload * with g0int_mul of 0
fun
{tk:tk}
g0int_div : g0int_aop_type(tk)
overload / with g0int_div of 0
fun
{tk:tk}
g0int_mod : g0int_aop_type(tk)
overload % with g0int_mod of 0
overload mod with g0int_mod of 0

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

fun{}
add_int1_size0{i:nat}(int(i), size_t):<> size_t
fun{}
add_size0_int1{j:nat}(size_t, int(j)):<> size_t

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

overload + with add_int1_size0 of 11
overload + with add_size0_int1 of 11

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

fun{}
mul_int1_size0{i:nat}(int(i), size_t):<> size_t
fun{}
mul_size0_int1{j:nat}(size_t, int(j)):<> size_t

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

overload * with mul_int1_size0 of 11
overload * with mul_size0_int1 of 11

(* ****** ****** *)
//
fun
{tk:tk}
g0int_asl
  (x: g0int(tk), n: intGte(0)):<> g0int(tk)
fun
{tk:tk}
g0int_asr
  (x: g0int(tk), n: intGte(0)):<> g0int(tk)
//
overload << with g0int_asl of 0
overload >> with g0int_asr of 0
//
(* ****** ****** *)
//
fun
{tk:tk}
g0int_npow
  (x: g0int(tk), n: intGte(0)):<> g0int(tk)
//
overload ** with g0int_npow of 0
//
(* ****** ****** *)
//
fun{tk:tk}
g0int_isltz (x: g0int (tk)):<> bool
fun{tk:tk}
g0int_isltez (x: g0int (tk)):<> bool
//
fun{tk:tk}
g0int_isgtz (x: g0int (tk)):<> bool
fun{tk:tk}
g0int_isgtez (x: g0int (tk)):<> bool
//
fun{tk:tk}
g0int_iseqz (x: g0int (tk)):<> bool
fun{tk:tk}
g0int_isneqz (x: g0int (tk)):<> bool
//
overload isltz with g0int_isltz of 0
overload isltez with g0int_isltez of 0
overload isgtz with g0int_isgtz of 0
overload isgtez with g0int_isgtez of 0
overload iseqz with g0int_iseqz of 0
overload isneqz with g0int_isneqz of 0
//
(* ****** ****** *)

typedef
g0int_cmp_type(tk:tk) =
  (g0int(tk), g0int(tk)) -<fun0> bool
// end of [g0int_cmp_type]

fun
{tk:tk}
g0int_lt : g0int_cmp_type(tk)
overload < with g0int_lt of 0
fun
{tk:tk}
g0int_lte : g0int_cmp_type(tk)
overload <= with g0int_lte of 0

fun
{tk:tk}
g0int_gt : g0int_cmp_type(tk)
overload > with g0int_gt of 0
fun
{tk:tk}
g0int_gte : g0int_cmp_type(tk)
overload >= with g0int_gte of 0

fun
{tk:tk}
g0int_eq : g0int_cmp_type(tk)
overload = with g0int_eq of 0
fun
{tk:tk}
g0int_neq : g0int_cmp_type(tk)
overload != with g0int_neq of 0
overload <> with g0int_neq of 0

(* ****** ****** *)
//
fun{tk:tk}
g0int_sgn(g0int(tk)): intBtwe(~1,1)
//
(* ****** ****** *)
//
fun{tk:tk}
g0int_compare
  (x: g0int(tk), y: g0int(tk)):<> int
//
overload compare with g0int_compare of 0
//
(* ****** ****** *)

fun
{tk:tk}
g0int_max : g0int_aop_type(tk)
overload max with g0int_max of 0
fun
{tk:tk}
g0int_min : g0int_aop_type(tk)
overload min with g0int_min of 0

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

fun{tk:tk}
lt_g0int_int (x: g0int (tk), y: int):<> bool
overload < with lt_g0int_int of 11
fun{tk:tk}
lte_g0int_int (x: g0int (tk), y: int):<> bool
overload <= with lte_g0int_int of 11
//
fun{tk:tk}
gt_g0int_int (x: g0int (tk), y: int):<> bool
overload > with gt_g0int_int of 11
fun{tk:tk}
gte_g0int_int (x: g0int (tk), y: int):<> bool
overload >= with gte_g0int_int of 11
//
fun{tk:tk}
eq_g0int_int (x: g0int (tk), y: int):<> bool
overload = with eq_g0int_int of 11
fun{tk:tk}
neq_g0int_int (x: g0int (tk), y: int):<> bool
overload != with neq_g0int_int of 11
overload <> with neq_g0int_int of 11
//
fun{tk:tk}
compare_g0int_int (x: g0int (tk), y: int):<> int
overload compare with compare_g0int_int of 11

(* ****** ****** *)
//
// HX: for indexed integer types
//
castfn
g0ofg1_int{tk:tk}(g1int(tk)):<> g0int(tk)
castfn
g1ofg0_int{tk:tk}(g0int(tk)):<> g1int(tk)
overload g0ofg1 with g0ofg1_int // index-erasing
overload g1ofg0 with g1ofg0_int // index-inducing
//
(* ****** ****** *)
//
fun{
k1,k2:tk
} g1int2int // i2i
  {i:int} (x: g1int (k1, i)):<> g1int (k2, i)
//
fun
g1int2int_int_int{i:int}(int(i)):<> int(i) = "mac#%"
//
(* ****** ****** *)

fun{tk:tk}
g1string2int (str: NSH(string)):<> g1int(tk)

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

prfun
g1int_get_index
  {tk:tk}{i1:int}
  (x: g1int(tk, i1)): [i2:int] EQINT(i1, i2)
// end of [g1int_get_index]

(* ****** ****** *)
//
typedef
g1int_neg_type (tk:tk) =
  {i:int} g1int(tk, i) -<fun0> g1int(tk, ~i)
//
fun
{tk:tk}
g1int_neg : g1int_neg_type(tk)
overload ~ with g1int_neg of 10 // ~ for uminus
overload neg with g1int_neg of 10

(* ****** ****** *)
//
typedef
g1int_abs_type (tk:tk) =
  {i:int} g1int (tk, i) -<fun0> g1int(tk, abs(i))
//
fun
{tk:tk}
g1int_abs : g1int_abs_type(tk)
overload abs with g1int_abs of 10
//
(* ****** ****** *)
//
typedef
g1int_succ_type (tk:tk) =
  {i:int} g1int (tk, i) -<fun0> g1int (tk, i+1)
//
fun{tk:tk}
g1int_succ : g1int_succ_type(tk)
overload succ with g1int_succ of 10
//
(* ****** ****** *)
//
typedef
g1int_pred_type (tk:tk) =
  {i:int} g1int (tk, i) -<fun0> g1int (tk, i-1)
//
fun{tk:tk}
g1int_pred : g1int_pred_type(tk)
overload pred with g1int_pred of 10
//
(* ****** ****** *)
//
typedef
g1int_half_type (tk:tk) =
  {i:int} g1int (tk, i) -<fun0> g1int (tk, i/2)
//
fun{tk:tk}
g1int_half : g1int_half_type(tk)
overload half with g1int_half of 10
//

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

(*
//
typedef
g1int_double_type
  (tk:tk) =
  {i:int}
  g1int (tk, i) -<fun0> g1int (tk, 2*i)
//
fun{tk:tk}
g1int_double : g1int_double_type(tk)
overload double with g1int_double of 10
//
*)

(* ****** ****** *)
//
typedef
g1int_add_type
  (tk:tk) =
  {i,j:int}
(
  g1int(tk, i)
, g1int(tk, j)
) -<fun0> g1int(tk, i+j)
//
fun
{tk:tk}
g1int_add : g1int_add_type(tk)
//
fun{}
add_size1_int1
  {i,j:int | i+j >= 0}
  (i: size_t(i), j: int(j)):<> size_t(i+j)
fun{}
add_int1_size1
  {i,j:int | i+j >= 0}
  (i: int(i), j: size_t(j)):<> size_t(i+j)
//
(* ****** ****** *)

overload + with g1int_add of 20
overload + with add_size1_int1 of 22
overload + with add_int1_size1 of 22

(* ****** ****** *)
//
typedef
g1int_sub_type
  (tk:tk) =
  {i,j:int}
(
  g1int(tk, i)
, g1int(tk, j)
) -<fun0> g1int(tk, i-j)
//
fun
{tk:tk}
g1int_sub : g1int_sub_type(tk)
//
fun{}
sub_size1_int1
  {i,j:int | i-j >= 0}
  (i: size_t(i), j: int(j)):<> size_t(i-j)
//
(* ****** ****** *)

overload - with g1int_sub of 20
overload - with sub_size1_int1 of 22

(* ****** ****** *)
//
typedef
g1int_mul_type
  (tk:tk) =
  {i,j:int}
(
  g1int(tk, i)
, g1int(tk, j)
) -<fun0> g1int(tk, i*j)
//
fun
{tk:tk}
g1int_mul : g1int_mul_type(tk)
//
fun
{tk:tk}
g1int_mul2
  {i,j:int}
(
  x: g1int (tk, i)
, y: g1int (tk, j)
) :<> [ij:int]
  (MUL (i, j, ij) | g1int (tk, ij))
// end of [g1int_mul2]
//
fun{}
mul_int1_size1
  {i,j:int | i >= 0}
  (i: int(i), j: size_t(j)):<> size_t(i*j)
fun{}
mul_size1_int1
  {i,j:int | j >= 0}
  (i: size_t(i), j: int(j)):<> size_t(i*j)
//
(* ****** ****** *)

overload * with g1int_mul of 20
overload * with mul_int1_size1 of 22
overload * with mul_size1_int1 of 22

(* ****** ****** *)
//
typedef
g1int_div_type
  (tk:tk) =
  {i,j:int | j != 0}
(
  g1int(tk, i), g1int(tk, j)
) -<fun0>
  [r:int | r == i/j ] g1int(tk, r)
//
typedef
g1int_ndiv_type
  (tk:tk) =
  {i,j:int | i >= 0; j > 0}
(
  g1int(tk, i), g1int(tk, j)
) -<fun0> g1int(tk, ndiv_int_int(i,j))
//
fun
{tk:tk}
g1int_div : g1int_div_type(tk)
fun
{tk:tk}
g1int_ndiv : g1int_ndiv_type(tk)
//
(* ****** ****** *)

fun
{tk:tk}
g1int_ndiv2
  {i,j:int | i >= 0; j > 0}
(
  x: g1int(tk, i), y: g1int(tk, j)
) :<>
[
  q,r:int | 0 <= r; r < j
] (
  DIVMOD (i, j, q, r) | g1int (tk, q)
) (* end of [g1int_ndiv2] *)

(* ****** ****** *)
//
fun{tk:tk}
ndiv_g1int_int1
  {i,j:int | i >= 0; j > 0}
(
  g1int(tk, i), int(j)
) :<> g1int(tk, ndiv_int_int(i,j))
//
(* ****** ****** *)
//
overload / with g1int_div of 20
//
overload ndiv with g1int_ndiv of 20
overload ndiv with ndiv_g1int_int1 of 21
//
(* ****** ****** *)

(*
** HX: [g1int_mod] is intentionally skipped
*)

(* ****** ****** *)
//
typedef
g1int_nmod_type
  (tk:tk) =
  {i,j:int | i >= 0; j > 0}
(
  g1int(tk, i), g1int(tk, j)
) -<fun0> g1int(tk, nmod_int_int(i, j))
//
fun{tk:tk}
g1int_nmod : g1int_nmod_type(tk)
//
overload nmod with g1int_nmod of 20
//
(* ****** ****** *)

fun{tk:tk}
g1int_nmod2
  {i,j:int | i >= 0; j > 0}
(
  x: g1int(tk, i), y: g1int(tk, j)
) :<> [q,r:nat | r < j]
(
  DIVMOD(i, j, q, r) | g1int(tk, r)
) (* end of [g1int_nmod2] *)

(* ****** ****** *)
//
fun{tk:tk}
nmod_g1int_int1
  {i,j:int | i >= 0; j > 0}
  (x: g1int(tk, i), y: int(j)):<> int(i%j)
//
fun{tk:tk}
nmod2_g1int_int1
  {i,j:int | i >= 0; j > 0}
(
  x: g1int(tk, i), y: int(j)
) :<> [q,r:nat | r < j] (DIVMOD(i, j, q, r) | int(r))
//
overload nmod with nmod_g1int_int1 of 21
//
(* ****** ****** *)
//
(*
//
// HX-2016-12:
// [ngcd] is no longer pre-declared
//
typedef
g1int_ngcd_type
  (tk:tk) =
  {i,j:int | i >= 0; j >= 0}
(
  g1int(tk, i), g1int(tk, j)
) -<fun0> g1int(tk, ngcd_int_int(i, j))
//
fun{tk:tk}
g1int_ngcd : g1int_ngcd_type(tk)
//
// overload ngcd with g1int_ngcd of 20
//
*)
//
(* ****** ****** *)
//
typedef
g1int_isltz_type
  (tk:tk) =
  {i:int}
  (g1int(tk, i)) -<fun0> bool(i < 0)
typedef
g1int_isltez_type
  (tk:tk) =
  {i:int}
  (g1int (tk, i)) -<fun0> bool(i <= 0)
//
fun{tk:tk}
g1int_isltz : g1int_isltz_type(tk)
fun{tk:tk}
g1int_isltez : g1int_isltez_type(tk)
//
overload isltz with g1int_isltz of 10
overload isltez with g1int_isltez of 10
//
(* ****** ****** *)
//
typedef
g1int_isgtz_type
  (tk:tk) =
  {i:int}
  (g1int(tk, i)) -<fun0> bool(i > 0)
typedef
g1int_isgtez_type
  (tk:tk) =
  {i:int}
  (g1int (tk, i)) -<fun0> bool(i >= 0)
//
fun{tk:tk}
g1int_isgtz : g1int_isgtz_type(tk)
fun{tk:tk}
g1int_isgtez : g1int_isgtez_type(tk)
//
overload isgtz with g1int_isgtz of 10
overload isgtez with g1int_isgtez of 10
//
(* ****** ****** *)
//
typedef
g1int_iseqz_type
  (tk:tk) =
  {i:int}
  (g1int (tk, i)) -<fun0> bool(i > 0)
typedef
g1int_isneqz_type
  (tk:tk) =
  {i:int}
  (g1int (tk, i)) -<fun0> bool(i >= 0)
//
fun{tk:tk}
g1int_iseqz : g1int_iseqz_type(tk)
fun{tk:tk}
g1int_isneqz : g1int_isneqz_type(tk)
//
overload iseqz with g1int_iseqz of 10
overload isneqz with g1int_isneqz of 10
//
(* ****** ****** *)
//
typedef
g1int_lt_type
  (tk:tk) =
  {i,j:int}
(
  g1int(tk, i)
, g1int(tk, j)
) -<fun0> bool(i < j)
//
typedef
g1int_lte_type
  (tk:tk) =
  {i,j:int}
(
  g1int(tk, i)
, g1int(tk, j)
) -<fun0> bool(i <= j)
//
fun{tk:tk}
g1int_lt : g1int_lt_type(tk)
overload < with g1int_lt of 20
fun{tk:tk}
g1int_lte : g1int_lte_type(tk)
overload <= with g1int_lte of 20
//
(* ****** ****** *)
//
typedef
g1int_gt_type
  (tk:tk) =
  {i,j:int}
(
  g1int(tk, i)
, g1int(tk, j)
) -<fun0> bool(i > j)
//
typedef
g1int_gte_type
  (tk:tk) =
  {i,j:int}
(
  g1int(tk, i)
, g1int(tk, j)
) -<fun0> bool(i >= j)
//
fun
{tk:tk}
g1int_gt : g1int_gt_type(tk)
overload > with g1int_gt of 20
fun
{tk:tk}
g1int_gte : g1int_gte_type(tk)
overload >= with g1int_gte of 20
//
(* ****** ****** *)
//
typedef
g1int_eq_type
  (tk:tk) =
  {i,j:int}
(
  g1int(tk, i)
, g1int(tk, j)
) -<fun0> bool(i == j)
typedef
g1int_neq_type
  (tk:tk) =
  {i,j:int}
(
  g1int(tk, i)
, g1int(tk, j)
) -<fun0> bool(i != j)
//
fun
{tk:tk}
g1int_eq : g1int_eq_type(tk)
overload = with g1int_eq of 20
fun
{tk:tk}
g1int_neq : g1int_neq_type(tk)
overload != with g1int_neq of 20
overload <> with g1int_neq of 20
//
(* ****** ****** *)
//
typedef
g1int_compare_type
  (tk:tk) =
  {i,j:int}
(
  g1int(tk, i)
, g1int(tk, j)
) -<fun0> int(sgn(i-j))
//
fun{tk:tk}
g1int_compare : g1int_compare_type(tk)
overload compare with g1int_compare of 20
//
(* ****** ****** *)
//
typedef
g1int_max_type
  (tk:tk) =
  {i,j:int}
(
  g1int(tk, i)
, g1int(tk, j)
) -<fun0> g1int(tk, max(i, j))
//
fun
{tk:tk}
g1int_max : g1int_max_type(tk)
overload max with g1int_max of 20
//
typedef
g1int_min_type
  (tk:tk) =
  {i,j:int}
(
  g1int(tk, i)
, g1int(tk, j)
) -<fun0> g1int(tk, min(i, j))
//
fun
{tk:tk}
g1int_min : g1int_min_type(tk)
overload min with g1int_min of 20
//
(* ****** ****** *)
//
fun{tk:tk}
lt_g1int_int{i,j:int}
  (g1int(tk, i), int(j)):<> bool(i < j)
fun{tk:tk}
lte_g1int_int{i,j:int}
  (g1int(tk, i), int(j)):<> bool(i <= j)
//
overload < with lt_g1int_int of 21
overload <= with lte_g1int_int of 21
//
fun{tk:tk}
gt_g1int_int{i,j:int}
  (g1int(tk, i), int(j)):<> bool(i > j)
fun{tk:tk}
gte_g1int_int{i,j:int}
  (g1int(tk, i), int(j)):<> bool(i >= j)
//
overload > with gt_g1int_int of 21
overload >= with gte_g1int_int of 21
//
fun{tk:tk}
eq_g1int_int{i,j:int}
  (g1int(tk, i), int(j)):<> bool(i == j)
overload = with eq_g1int_int of 21
fun{tk:tk}
neq_g1int_int{i,j:int}
  (g1int(tk, i), int(j)):<> bool(i != j)
//
overload != with neq_g1int_int of 21
overload <> with neq_g1int_int of 21
//
fun{tk:tk}
compare_g1int_int{i,j:int}
  (g1int(tk, i), int(j)):<> int(sgn(i-j))
//
overload compare with compare_g1int_int of 21
//
(* ****** ****** *)

fun
{tk:tk}
g1int_sgn{i:int}(g1int(tk, i)):<> int(sgn(i))

(* ****** ****** *)
//
// HX: for unsigned unindexed integer types
//
(* ****** ****** *)

fun{
k1,k2:tk
} g0int2uint(g0int(k1)):<> g0uint(k2)
//
fun
g0int2uint_int_uint(int):<> uint = "mac#%"
//
(* ****** ****** *)

fun{
k1,k2:tk
} g0uint2int(g0uint(k1)):<> g0int(k2)
//
fun
g0uint2int_uint_int(uint):<> int = "mac#%"
//
(* ****** ****** *)
//
fun{
k1,k2:tk
} g0uint2uint(g0uint(k1)):<> g0uint(k2)
//
fun
g0uint2uint_uint_uint(uint):<> uint = "mac#%"
//
(* ****** ****** *)
//
fun{tk:tk}
g0string2uint(rep: NSH(string)):<> g0uint(tk)
//
fun
g0string2uint_uint(rep: NSH(string)):<> uint = "mac#%"
//
(* ****** ****** *)
//
fun{tk:tk}
g0uint_succ
  (g0uint(tk)):<> g0uint(tk)
fun{tk:tk}
g0uint_pred
  (g0uint(tk)):<> g0uint(tk)
//
overload succ with g0uint_succ of 0
overload pred with g0uint_pred of 0
//
(* ****** ****** *)
//
fun{tk:tk}
g0uint_half
  (g0uint(tk)):<> g0uint(tk)
//
overload half with g0uint_half of 0
//
(*
fun{tk:tk}
g0uint_double
  (g0uint(tk)):<> g0uint(tk)
overload double with g0uint_double of 0
*)
//
(* ****** ****** *)
//
fun{
tk:tk
} g0uint_add
  (x: g0uint (tk), y: g0uint (tk)):<> g0uint (tk)
overload + with g0uint_add of 0
fun{
tk:tk
} g0uint_sub
  (x: g0uint (tk), y: g0uint (tk)):<> g0uint (tk)
overload - with g0uint_sub of 0
fun{
tk:tk
} g0uint_mul
  (x: g0uint (tk), y: g0uint (tk)):<> g0uint (tk)
overload * with g0uint_mul of 0
fun{
tk:tk
} g0uint_div
  (x: g0uint (tk), y: g0uint (tk)):<> g0uint (tk)
overload / with g0uint_div of 0
fun{
tk:tk
} g0uint_mod
  (x: g0uint (tk), y: g0uint (tk)):<> g0uint (tk)
overload % with g0uint_mod of 0
overload mod with g0uint_mod of 0
//
(* ****** ****** *)
//
fun
{tk:tk}
g0uint_lsl
(
  x: g0uint(tk), n: intGte(0)
) :<> g0uint(tk)
fun
{tk:tk}
g0uint_lsr
(
  x: g0uint(tk), n: intGte(0)
) :<> g0uint(tk)
//
overload << with g0uint_lsl of 10
overload >> with g0uint_lsr of 10
//
(* ****** ****** *)
//
fun
{tk:tk}
g0uint_lnot
  (g0uint(tk)):<> g0uint(tk)
overload ~ with g0uint_lnot
overload lnot with g0uint_lnot
//
fun
{tk:tk}
g0uint_lor
  (g0uint(tk), g0uint(tk)):<> g0uint(tk)
fun
{tk:tk}
g0uint_lxor
  (g0uint(tk), g0uint(tk)):<> g0uint(tk)
fun
{tk:tk}
g0uint_land
  (g0uint(tk), g0uint(tk)):<> g0uint(tk)
//
overload lor with g0uint_lor
overload lxor with g0uint_lxor
overload land with g0uint_land
//
(* ****** ****** *)
//
fun{tk:tk}
g0uint_isgtz(x: g0uint(tk)):<> bool
fun{tk:tk}
g0uint_iseqz(x: g0uint(tk)):<> bool
fun{tk:tk}
g0uint_isneqz(x: g0uint(tk)):<> bool
//
overload isgtz with g0uint_isgtz of 0
overload iseqz with g0uint_iseqz of 0
overload isneqz with g0uint_isneqz of 0
//
(* ****** ****** *)
//
fun{
tk:tk
} g0uint_lt
  (x: g0uint (tk), y: g0uint (tk)):<> bool
overload < with g0uint_lt of 0
fun{
tk:tk
} g0uint_lte
  (x: g0uint (tk), y: g0uint (tk)):<> bool
overload <= with g0uint_lte of 0
//
fun{
tk:tk
} g0uint_gt
  (x: g0uint (tk), y: g0uint (tk)):<> bool
overload > with g0uint_gt of 0
fun{
tk:tk
} g0uint_gte
  (x: g0uint (tk), y: g0uint (tk)):<> bool
overload >= with g0uint_gte of 0
//
fun{
tk:tk
} g0uint_eq
  (x: g0uint (tk), y: g0uint (tk)):<> bool
overload = with g0uint_eq of 0
fun{
tk:tk
} g0uint_neq
  (x: g0uint (tk), y: g0uint (tk)):<> bool
overload != with g0uint_neq of 0
overload <> with g0uint_neq of 0
//
fun{tk:tk}
g0uint_compare
  (x: g0uint(tk), y: g0uint(tk)):<> int
//
overload compare with g0uint_compare of 0
//
(* ****** ****** *)

fun
{tk:tk}
g0uint_max
  (g0uint(tk), g0uint(tk)):<> g0uint(tk)

fun
{tk:tk}
g0uint_min
  (g0uint(tk), g0uint(tk)):<> g0uint(tk)
//
overload max with g0uint_max of 0
overload min with g0uint_min of 0
//
(* ****** ****** *)
//
fun{tk:tk}
lt_g0uint_int
  (x: g0uint(tk), y: int):<> bool
fun{tk:tk}
lte_g0uint_int
  (x: g0uint(tk), y: int):<> bool
//
overload < with lt_g0uint_int of 11
overload <= with lte_g0uint_int of 11
//
fun{tk:tk}
gt_g0uint_int
  (x: g0uint(tk), y: int):<> bool
fun{tk:tk}
gte_g0uint_int
  (x: g0uint(tk), y: int):<> bool
//
overload > with gt_g0uint_int of 11
overload >= with gte_g0uint_int of 11
//
fun{tk:tk}
eq_g0uint_int
  (x: g0uint(tk), y: int):<> bool
fun{tk:tk}
neq_g0uint_int
  (x: g0uint(tk), y: int):<> bool
//
overload = with eq_g0uint_int of 11
overload != with neq_g0uint_int of 11
overload <> with neq_g0uint_int of 11
//
(* ****** ****** *)
//
// HX: for unsigned indexed integer types
//
praxi
lemma_g1uint_param
  {tk:tk}{i:int}(g1uint(tk, i)):<> [i >= 0] void
// end of [lemma_g1uint_param]
//
(* ****** ****** *)

castfn
size_of_int{i:nat}(x: int(i)):<> size_t(i)
castfn
ssize_of_int{i:int}(x: int(i)):<> ssize_t(i)

(* ****** ****** *)
//
castfn
g0ofg1_uint{tk:tk}(x: g1uint tk):<> g0uint (tk)
castfn
g1ofg0_uint{tk:tk}(x: g0uint tk):<> g1uint0 (tk)
//
overload g0ofg1 with g0ofg1_uint // index-erasing
overload g1ofg0 with g1ofg0_uint // index-inducing
//
(* ****** ****** *)
//
typedef
g1int2int_type
  (k1:tk, k2:tk) = 
  {i:int}
  (g1int(k1, i)) -<fun0> g1int(k2, i)
typedef
g1int2uint_type
  (k1:tk, k2:tk) =
  {i:nat}
  (g1int(k1, i)) -<fun0> g1uint(k2, i)
//
fun{
k1,k2:tk
} g1int2int : g1int2int_type(k1, k2)
fun{
k1,k2:tk
} g1int2uint : g1int2uint_type(k1, k2)
//
fun
g1int2int_int_int:
g1int2int_type(intknd, intknd) = "mac#%"
fun
g1int2uint_int_uint:
g1int2uint_type(intknd, uintknd) = "mac#%"
//
(* ****** ****** *)
//
typedef
g1uint2int_type
  (k1:tk, k2:tk) = 
  {u:int}
(
  g1uint(k1, u)
) -<fun0> [u>=0] g1int(k2, u)
typedef
g1uint2uint_type
  (k1:tk, k2:tk) =
  {u:int}
  (g1uint(k1, u)) -<fun0> g1uint(k2, u)
//
fun{
k1,k2:tk
} g1uint2int : g1uint2int_type(k1, k2)
fun{
k1,k2:tk
} g1uint2uint : g1uint2uint_type(k1, k2)
//
fun
g1uint2int_uint_int:
g1uint2int_type(uintknd, intknd) = "mac#%"
fun
g1uint2uint_uint_uint:
g1uint2uint_type(uintknd, uintknd) = "mac#%"
//
(* ****** ****** *)
//
fun{tk:tk}
g1string2uint(rep: NSH(string)):<> g1uint(tk)
//
(* ****** ****** *)
//
prfun
g1uint_get_index
  {tk:tk}{i1:int}
  (x: g1uint(tk, i1)): [i2:int] EQINT(i1, i2)
//
(* ****** ****** *)
//
typedef
g1uint_succ_type
  (tk:tk) =
  {i:int}
  (g1uint(tk, i)) -<fun0> g1uint(tk, i+1)
typedef
g1uint_pred_type
  (tk:tk) =
  {i:int | i > 0}
  (g1uint(tk, i)) -<fun0> g1uint(tk, i-1)
//
fun{tk:tk}
g1uint_succ : g1uint_succ_type(tk)
overload succ with g1uint_succ of 10
fun{tk:tk}
g1uint_pred : g1uint_pred_type(tk)
overload pred with g1uint_pred of 10
//
(* ****** ****** *)
//
typedef
g1uint_half_type
  (tk:tk) =
  {i:int}
(
  g1uint(tk, i)
) -<fun0> g1uint(tk, i/2)
//
fun{tk:tk}
g1uint_half : g1uint_half_type(tk)
overload half with g1uint_half of 10
//
typedef
g1uint_double_type
  (tk:tk) =
  {i:int}
(
  g1uint(tk, i)
) -<fun0> g1uint(tk, 2*i)
//
fun{tk:tk}
g1uint_double : g1uint_double_type(tk)
overload double with g1uint_double of 10
//
(* ****** ****** *)
//
typedef
g1uint_add_type
  (tk:tk) =
  {i,j:int}
(
  g1uint(tk, i)
, g1uint(tk, j)
) -<fun0> g1uint(tk, i+j)
typedef
g1uint_sub_type
  (tk:tk) =
  {i,j:int | i >= j}
(
  g1uint(tk, i)
, g1uint(tk, j)
) -<fun0> g1uint (tk, i-j)
//
fun
{tk:tk}
g1uint_add : g1uint_add_type(tk)
fun
{tk:tk}
g1uint_sub : g1uint_sub_type(tk)
//
overload + with g1uint_add of 20
overload - with g1uint_sub of 20
//
(* ****** ****** *)
//
typedef
g1uint_mul_type
  (tk:tk) =
  {i,j:int}
(
  g1uint(tk, i)
, g1uint(tk, j)
) -<fun0> g1uint (tk, i*j)
//
fun
{tk:tk}
g1uint_mul : g1uint_mul_type(tk)
fun
{tk:tk}
g1uint_mul2
  {i,j:int}
(
  x: g1uint(tk, i), y: g1uint(tk, j)
) :<> [ij:int] (MUL(i, j, ij) | g1uint(tk, ij))
//
overload * with g1uint_mul of 20
//
(* ****** ****** *)
//
typedef
g1uint_div_type
  (tk:tk) =
  {i,j:int | j > 0}
(
  g1uint(tk, i)
, g1uint(tk, j)
) -<fun0>
  [r:nat | r == ndiv_int_int(i,j)] g1uint(tk, r)
// end of [g1uint_div_type]
//
fun
{tk:tk}
g1uint_div : g1uint_div_type(tk)
fun
{tk:tk}
g1uint_div2 {i,j:int | j > 0}
(
  x: g1uint (tk, i), y: g1uint (tk, j)
) :<> [q,r:int | 0 <= r; r < j] (DIVMOD (i, j, q, r) | g1uint (tk, q))
//
overload / with g1uint_div of 20
//
(* ****** ****** *)
//
typedef
g1uint_mod_type
  (tk:tk) =
  {i,j:int | j > 0}
(
  g1uint(tk, i)
, g1uint (tk, j)
) -<fun0> [r:nat | r < j] g1uint (tk, r)
// end of [g1uint_mod_type]
//
fun
{tk:tk}
g1uint_mod : g1uint_mod_type(tk)
fun
{tk:tk}
g1uint_mod2
  {i,j:int | j > 0}
(
  x: g1uint (tk, i), y: g1uint (tk, j)
) :<>
[
  q,r:int | 0 <= r; r < j
] (
  DIVMOD (i, j, q, r) | g1uint (tk, r)
) (* end of [g1uint_mod2] *)
//
overload mod with g1uint_mod of 20
//
(* ****** ****** *)
//
typedef
g1uint_isgtz_type
  (tk:tk) =
  {i:int}
  (g1uint(tk, i)) -<fun0> bool(i > 0)
//
fun{tk:tk}
g1uint_isgtz : g1uint_isgtz_type(tk)
overload isgtz with g1uint_isgtz of 10
//
(* ****** ****** *)
//
typedef
g1uint_iseqz_type
  (tk:tk) =
  {i:int}
  (g1uint(tk, i)) -<fun0> bool(i > 0)
typedef
g1uint_isneqz_type
  (tk:tk) =
  {i:int}
  (g1uint(tk, i)) -<fun0> bool(i >= 0)
//
fun{tk:tk}
g1uint_iseqz : g1uint_iseqz_type(tk)
fun{tk:tk}
g1uint_isneqz : g1uint_isneqz_type(tk)
//
overload iseqz with g1uint_iseqz of 10
overload isneqz with g1uint_isneqz of 10
//
(* ****** ****** *)
//
typedef
g1uint_lt_type
  (tk:tk) =
  {i,j:int}
(
  g1uint(tk, i), g1uint(tk, j)
) -<fun0> bool(i < j) // endfun
typedef
g1uint_lte_type
  (tk:tk) =
  {i,j:int}
(
  g1uint(tk, i), g1uint(tk, j)
) -<fun0> bool(i <= j) // endfun
//
fun{tk:tk}
g1uint_lt : g1uint_lt_type(tk)
fun{tk:tk}
g1uint_lte : g1uint_lte_type(tk)
//
overload < with g1uint_lt of 20
overload <= with g1uint_lte of 20
//
(* ****** ****** *)

typedef
g1uint_gt_type
  (tk:tk) =
  {i,j:int}
(
  g1uint(tk, i), g1uint(tk, j)
) -<fun0> bool(i > j) // endfun
typedef
g1uint_gte_type
  (tk:tk) =
  {i,j:int}
(
  g1uint(tk, i), g1uint(tk, j)
) -<fun0> bool(i >= j) // endfun
//
fun
{tk:tk}
g1uint_gt : g1uint_gt_type(tk)
fun
{tk:tk}
g1uint_gte : g1uint_gte_type(tk)
//
overload > with g1uint_gt of 20
overload >= with g1uint_gte of 20
//
(* ****** ****** *)
//
typedef
g1uint_eq_type
  (tk:tk) =
  {i,j:int}
(
  g1uint(tk, i)
, g1uint(tk, j)
) -<fun0> bool(i == j)
typedef
g1uint_neq_type
  (tk:tk) =
  {i,j:int}
(
  g1uint(tk, i)
, g1uint(tk, j)
) -<fun0> bool(i != j)
//
fun
{tk:tk}
g1uint_eq : g1uint_eq_type(tk)
fun
{tk:tk}
g1uint_neq : g1uint_neq_type(tk)
//
overload = with g1uint_eq of 20
overload != with g1uint_neq of 20
overload <> with g1uint_neq of 20
//
(* ****** ****** *)
//
typedef
g1uint_compare_type
  (tk:tk) =
  {i,j:int}
(
  g1uint(tk, i)
, g1uint(tk, j)
) -<fun0> int(sgn(i-j))
//
fun{tk:tk}
g1uint_compare : g1uint_compare_type(tk)
//
overload compare with g1uint_compare of 20
//
(* ****** ****** *)
//
typedef
g1uint_max_type
  (tk:tk) =
  {i,j:int}
(
  g1uint(tk, i)
, g1uint(tk, j)
) -<fun0> g1uint(tk, max(i, j))
typedef
g1uint_min_type
  (tk:tk) =
  {i,j:int}
(
  g1uint(tk, i)
, g1uint(tk, j)
) -<fun0> g1uint(tk, min(i, j))
//
fun
{tk:tk}
g1uint_max : g1uint_max_type(tk)
fun
{tk:tk}
g1uint_min : g1uint_min_type(tk)
//
overload max with g1uint_max of 20
overload min with g1uint_min of 20
//
(* ****** ****** *)
//
fun{tk:tk}
lt_g1uint_int{i:int;j:nat}
  (g1uint(tk, i), int(j)):<> bool(i < j)
fun{tk:tk}
lte_g1uint_int{i:int;j:nat}
  (g1uint(tk, i), int(j)):<> bool(i <= j)
//
overload < with lt_g1uint_int of 21
overload <= with lte_g1uint_int of 21
//
fun{tk:tk}
gt_g1uint_int{i:int;j:nat}
  (g1uint(tk, i), int(j)):<> bool(i > j)
fun{tk:tk}
gte_g1uint_int{i:int;j:nat}
  (g1uint(tk, i), int(j)):<> bool(i >= j)
//
overload > with gt_g1uint_int of 21
overload >= with gte_g1uint_int of 21
//
fun{tk:tk}
eq_g1uint_int{i:int;j:nat}
  (g1uint(tk, i), int(j)):<> bool(i == j)
fun{tk:tk}
neq_g1uint_int{i:int;j:nat}
  (g1uint(tk, i), int(j)):<> bool(i != j)
//
overload = with eq_g1uint_int of 21
overload != with neq_g1uint_int of 21
overload <> with neq_g1uint_int of 21
//
(* ****** ****** *)
//
fun print_int (int): void = "mac#%"
fun prerr_int (int): void = "mac#%"
fun fprint_int : fprint_type (int) = "mac#%"
overload print with print_int
overload prerr with prerr_int
overload fprint with fprint_int
//
fun print_uint (uint): void = "mac#%"
fun prerr_uint (uint): void = "mac#%"
fun fprint_uint : fprint_type (uint) = "mac#%"
overload print with print_uint
overload prerr with prerr_uint
overload fprint with fprint_uint
//
(* ****** ****** *)
//
fun g0int_neg_int (x: int):<> int = "mac#%"
fun g0int_abs_int (x: int):<> int = "mac#%"
fun g0int_succ_int (x: int):<> int = "mac#%"
fun g0int_pred_int (x: int):<> int = "mac#%"
fun g0int_half_int (x: int):<> int = "mac#%"
fun g0int_asl_int (x: int, n: intGte(0)):<> int = "mac#%"
fun g0int_asr_int (x: int, n: intGte(0)):<> int = "mac#%"
fun g0int_add_int (x: int, y: int):<> int = "mac#%"
fun g0int_sub_int (x: int, y: int):<> int = "mac#%"
fun g0int_mul_int (x: int, y: int):<> int = "mac#%"
fun g0int_div_int (x: int, y: int):<> int = "mac#%"
fun g0int_mod_int (x: int, y: int):<> int = "mac#%"
fun g0int_lt_int (x: int, y: int):<> bool = "mac#%"
fun g0int_lte_int (x: int, y: int):<> bool = "mac#%"
fun g0int_gt_int (x: int, y: int):<> bool = "mac#%"
fun g0int_gte_int (x: int, y: int):<> bool = "mac#%"
fun g0int_eq_int (x: int, y: int):<> bool = "mac#%"
fun g0int_neq_int (x: int, y: int):<> bool = "mac#%"
fun g0int_compare_int (x: int, y: int):<> int = "mac#%"
fun g0int_max_int (x: int, y: int):<> int = "mac#%"
fun g0int_min_int (x: int, y: int):<> int = "mac#%"
fun g0int_isltz_int (x: int):<> bool = "mac#%"
fun g0int_isltez_int (x: int):<> bool = "mac#%"
fun g0int_isgtz_int (x: int):<> bool = "mac#%"
fun g0int_isgtez_int (x: int):<> bool = "mac#%"
fun g0int_iseqz_int (x: int):<> bool = "mac#%"
fun g0int_isneqz_int (x: int):<> bool = "mac#%"
//
(* ****** ****** *)
//
fun g0uint_succ_uint (x: uint):<> uint = "mac#%"
fun g0uint_pred_uint (x: uint):<> uint = "mac#%"
fun g0uint_half_uint (x: uint):<> uint = "mac#%"
fun g0uint_add_uint (x: uint, y: uint):<> uint = "mac#%"
fun g0uint_sub_uint (x: uint, y: uint):<> uint = "mac#%"
fun g0uint_mul_uint (x: uint, y: uint):<> uint = "mac#%"
fun g0uint_div_uint (x: uint, y: uint):<> uint = "mac#%"
fun g0uint_mod_uint (x: uint, y: uint):<> uint = "mac#%"
fun g0uint_lsl_uint (x: uint, n: intGte(0)):<> uint = "mac#%"
fun g0uint_lsr_uint (x: uint, n: intGte(0)):<> uint = "mac#%"
fun g0uint_lnot_uint (x: uint):<> uint = "mac#%"
fun g0uint_lor_uint (x: uint, y: uint):<> uint = "mac#%"
fun g0uint_lxor_uint (x: uint, y: uint):<> uint = "mac#%"
fun g0uint_land_uint (x: uint, y: uint):<> uint = "mac#%"
fun g0uint_lt_uint (x: uint, y: uint):<> bool = "mac#%"
fun g0uint_lte_uint (x: uint, y: uint):<> bool = "mac#%"
fun g0uint_gt_uint (x: uint, y: uint):<> bool = "mac#%"
fun g0uint_gte_uint (x: uint, y: uint):<> bool = "mac#%"
fun g0uint_eq_uint (x: uint, y: uint):<> bool = "mac#%"
fun g0uint_neq_uint (x: uint, y: uint):<> bool = "mac#%"
fun g0uint_compare_uint (x: uint, y: uint):<> int = "mac#%"
fun g0uint_max_uint (x: uint, y: uint):<> uint = "mac#%"
fun g0uint_min_uint (x: uint, y: uint):<> uint = "mac#%"
fun g0uint_isgtz_uint (x: uint):<> bool = "mac#%"
fun g0uint_iseqz_uint (x: uint):<> bool = "mac#%"
fun g0uint_isneqz_uint (x: uint):<> bool = "mac#%"
//
(* ****** ****** *)
//
fun g1int_neg_int : g1int_neg_type (intknd) = "mac#%"
fun g1int_abs_int : g1int_abs_type (intknd) = "mac#%"
fun g1int_succ_int : g1int_succ_type (intknd) = "mac#%"
fun g1int_pred_int : g1int_pred_type (intknd) = "mac#%"
fun g1int_half_int : g1int_half_type (intknd) = "mac#%"
fun g1int_add_int : g1int_add_type (intknd) = "mac#%"
fun g1int_sub_int : g1int_sub_type (intknd) = "mac#%"
fun g1int_mul_int : g1int_mul_type (intknd) = "mac#%"
fun g1int_div_int : g1int_div_type (intknd) = "mac#%"
fun g1int_nmod_int : g1int_nmod_type (intknd) = "mac#%"
fun g1int_lt_int : g1int_lt_type (intknd) = "mac#%"
fun g1int_lte_int : g1int_lte_type (intknd) = "mac#%"
fun g1int_gt_int : g1int_gt_type (intknd) = "mac#%"
fun g1int_gte_int : g1int_gte_type (intknd) = "mac#%"
fun g1int_eq_int : g1int_eq_type (intknd) = "mac#%"
fun g1int_neq_int : g1int_neq_type (intknd) = "mac#%"
fun g1int_compare_int : g1int_compare_type (intknd) = "mac#%"
fun g1int_max_int : g1int_max_type (intknd) = "mac#%"
fun g1int_min_int : g1int_min_type (intknd) = "mac#%"
fun g1int_isltz_int : g1int_isltz_type (intknd) = "mac#%"
fun g1int_isltez_int : g1int_isltez_type (intknd) = "mac#%"
fun g1int_isgtz_int : g1int_isgtz_type (intknd) = "mac#%"
fun g1int_isgtez_int : g1int_isgtez_type (intknd) = "mac#%"
fun g1int_iseqz_int : g1int_iseqz_type (intknd) = "mac#%"
fun g1int_isneqz_int : g1int_isneqz_type (intknd) = "mac#%"
//
(* ****** ****** *)
//
fun g1uint_succ_uint : g1uint_succ_type (uintknd) = "mac#%"
fun g1uint_pred_uint : g1uint_pred_type (uintknd) = "mac#%"
fun g1uint_half_uint : g1uint_half_type (uintknd) = "mac#%"
fun g1uint_add_uint : g1uint_add_type (uintknd) = "mac#%"
fun g1uint_sub_uint : g1uint_sub_type (uintknd) = "mac#%"
fun g1uint_mul_uint : g1uint_mul_type (uintknd) = "mac#%"
fun g1uint_div_uint : g1uint_div_type (uintknd) = "mac#%"
fun g1uint_mod_uint : g1uint_mod_type (uintknd) = "mac#%"
fun g1uint_lt_uint : g1uint_lt_type (uintknd) = "mac#%"
fun g1uint_lte_uint : g1uint_lte_type (uintknd) = "mac#%"
fun g1uint_gt_uint : g1uint_gt_type (uintknd) = "mac#%"
fun g1uint_gte_uint : g1uint_gte_type (uintknd) = "mac#%"
fun g1uint_eq_uint : g1uint_eq_type (uintknd) = "mac#%"
fun g1uint_neq_uint : g1uint_neq_type (uintknd) = "mac#%"
fun g1uint_compare_uint : g1uint_compare_type (uintknd) = "mac#%"
fun g1uint_max_uint : g1uint_max_type (uintknd) = "mac#%"
fun g1uint_min_uint : g1uint_min_type (uintknd) = "mac#%"
fun g1uint_isgtz_uint : g1uint_isgtz_type (uintknd) = "mac#%"
fun g1uint_iseqz_uint : g1uint_iseqz_type (uintknd) = "mac#%"
fun g1uint_isneqz_uint : g1uint_isneqz_type (uintknd) = "mac#%"
//
(* ****** ****** *)
//
macdef
i2u(x) = g1int2uint_int_uint(,(x))
macdef
u2i(x) = g1uint2int_uint_int(,(x))
//
(* ****** ****** *)
//
macdef g0i2i(x) = g0int2int(,(x))
macdef g1i2i(x) = g1int2int(,(x))
//
macdef g0i2u(x) = g0int2uint(,(x))
macdef g1i2u(x) = g1int2uint(,(x))
//
macdef g0u2i(x) = g0uint2int(,(x))
macdef g1u2i(x) = g1uint2int(,(x))
//
macdef g0u2u(x) = g0uint2uint(,(x))
macdef g1u2u(x) = g1uint2uint(,(x))
//
(* ****** ****** *)
//
// HX: implemented in [list_vt.dats]
//
fun{tk:tk}
listize_g0int_rep
  {b:int | b >= 2}
  (g0int(tk), int(b)):<!wrt> List0_vt(intBtw(0, b))
//
fun{tk:tk}
listize_g0uint_rep
  {b:int | b >= 2}
  (g0uint(tk), int(b)):<!wrt> List0_vt(intBtw(0, b))
//
(* ****** ****** *)

(* end of [integer.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/pointer.atxt
** Time of generation: Fri Aug 18 03:29:48 2017
*)

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

(* Author: Hongwei Xi *)
(* Start time: March, 2012 *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)

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

sortdef tk = tkind

(* ****** ****** *)
//
sortdef
t0p = t@ype and vt0p = viewt@ype
//
(* ****** ****** *)

stadef ptrknd = ptr_kind

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

absprop is_word_aligned_p (l:addr)

(* ****** ****** *)
//
castfn
g0ofg1_ptr (p: Ptr):<> ptr
castfn
g1ofg0_ptr (p: ptr):<> Ptr0
//
overload g0ofg1 with g0ofg1_ptr
overload g1ofg0 with g1ofg0_ptr
//
(* ****** ****** *)
//
prfun
lemma_ptr_param
  {l:addr} (p: ptr l): [l >= null] void
//
(* ****** ****** *)

prfun
ptr_get_index
  {l1:addr} (p: ptr l1): [l2:addr] EQADDR(l1, l2)
// end of [ptr_get_index]

(* ****** ****** *)
//
symintr ptr_is_null
symintr ptr_isnot_null
//
(* ****** ****** *)
//
symintr add_ptr_bsz
symintr sub_ptr_bsz
//
// add_ptr_bsz (p, ofs) = p + ofs
// sub_ptr_bsz (p, ofs) = p - ofs
//
(* ****** ****** *)
//
symintr ptr_succ
symintr ptr_pred
//
// ptr_succ<a>(p) = p + sizeof<a>
// ptr_pred<a>(p) = p - sizeof<a>
//
(* ****** ****** *)
//
symintr ptr_add ptr_sub
//
// ptr_add<a> (p, ofs) = p + ofs*sizeof<a>
// ptr_sub<a> (p, ofs) = p - ofs*sizeof<a>
//
(* ****** ****** *)

fun ptr0_is_null (p: ptr):<> bool = "mac#%"
overload ptr_is_null with ptr0_is_null of 0
fun ptr0_isnot_null (p: ptr):<> bool = "mac#%"
overload ptr_isnot_null with ptr0_isnot_null of 0

(* ****** ****** *)
//
fun add_ptr0_bsz
  (p: ptr, ofs: size_t):<> ptr = "mac#%"
fun sub_ptr0_bsz
  (p: ptr, ofs: size_t):<> ptr = "mac#%"
//
overload add_ptr_bsz with add_ptr0_bsz of 0
overload sub_ptr_bsz with sub_ptr0_bsz of 0
//
(* ****** ****** *)

fun sub_ptr0_ptr0
  (p1: ptr, p2: ptr):<> ssize_t = "mac#%"
overload - with sub_ptr0_ptr0 of 0

(* ****** ****** *)
//
fun{a:vt0p} ptr0_succ(p: ptr):<> ptr
fun{a:vt0p} ptr0_pred(p: ptr):<> ptr
//
overload ptr_succ with ptr0_succ of 0
overload ptr_pred with ptr0_pred of 0
//
(* ****** ****** *)
//
fun{
a:vt0p
} ptr0_diff(p1: ptr, p2: ptr): ssize_t
//
(* ****** ****** *)
//
fun{
a:vt0p}{tk:tk
} ptr0_add_gint(p: ptr, ofs: g0int(tk)):<> ptr
fun{
a:vt0p}{tk:tk
} ptr0_add_guint(p: ptr, ofs: g0uint(tk)):<> ptr
//
overload ptr_add with ptr0_add_gint of 0
overload ptr_add with ptr0_add_guint of 0
//
fun{
a:vt0p}{tk:tk
} ptr0_sub_gint (p: ptr, ofs: g0int (tk)):<> ptr
fun{
a:vt0p}{tk:tk
} ptr0_sub_guint (p: ptr, ofs: g0uint (tk)):<> ptr
//
overload ptr_sub with ptr0_sub_gint of 0
overload ptr_sub with ptr0_sub_guint of 0
//
(* ****** ****** *)

fun lt_ptr0_ptr0
  (p1: ptr, p2: ptr):<> bool = "mac#%"
overload < with lt_ptr0_ptr0 of 0
fun lte_ptr0_ptr0
  (p1: ptr, p2: ptr):<> bool = "mac#%"
overload <= with lte_ptr0_ptr0 of 0
fun gt_ptr0_ptr0
  (p1: ptr, p2: ptr):<> bool = "mac#%"
overload > with gt_ptr0_ptr0 of 0
fun gte_ptr0_ptr0
  (p1: ptr, p2: ptr):<> bool = "mac#%"
overload >= with gte_ptr0_ptr0 of 0
fun eq_ptr0_ptr0
  (p1: ptr, p2: ptr):<> bool = "mac#%"
overload = with eq_ptr0_ptr0 of 0
fun neq_ptr0_ptr0
  (p1: ptr, p2: ptr):<> bool = "mac#%"
overload != with neq_ptr0_ptr0 of 0
overload <> with neq_ptr0_ptr0 of 0

(* ****** ****** *)
//
fun
compare_ptr0_ptr0
  (p1: ptr, p2: ptr):<> int = "mac#%"
//
overload compare with compare_ptr0_ptr0 of 0
//
(* ****** ****** *)
//
fun
gt_ptr0_intz
  (p: ptr, i: int(0)):<> bool = "mac#%"
//
fun
eq_ptr0_intz
  (p: ptr, i: int(0)):<> bool = "mac#%"
fun
neq_ptr0_intz
  (p: ptr, i: int(0)):<> bool = "mac#%"
//
overload > with gt_ptr0_intz of 0
overload = with eq_ptr0_intz of 0
overload != with neq_ptr0_intz of 0
overload <> with neq_ptr0_intz of 0
//
(* ****** ****** *)

(*
fun{a:vt0p}
ptr0_add_int (p: ptr, i: int): ptr
fun{a:vt0p}
ptr0_add_lint (p: ptr, i: lint): ptr
fun{a:vt0p}
ptr0_add_ssize (p: ptr, i: ssize): ptr
fun{a:vt0p}
ptr0_add_uint (p: ptr, u: uint): ptr
fun{a:vt0p}
ptr0_add_ulint (p: ptr, u: ulint): ptr
fun{a:vt0p}
ptr0_add_size (p: ptr, u: size): ptr
*)

(*
fun{a:vt0p}
ptr0_sub_int (p: ptr, i: int): ptr
fun{a:vt0p}
ptr0_sub_lint (p: ptr, i: lint): ptr
fun{a:vt0p}
ptr0_sub_ssize (p: ptr, i: ssize): ptr
fun{a:vt0p}
ptr0_sub_uint (p: ptr, u: uint): ptr
fun{a:vt0p}
ptr0_sub_ulint (p: ptr, u: ulint): ptr
fun{a:vt0p}
ptr0_sub_size (p: ptr, u: size): ptr
*)

(* ****** ****** *)
//
fun
print_ptr (p: ptr): void = "mac#%"
fun
prerr_ptr (p: ptr): void = "mac#%"
fun
fprint_ptr : fprint_type (ptr) = "mac#%"
//
overload print with print_ptr
overload prerr with prerr_ptr
overload fprint with fprint_ptr
//
(* ****** ****** *)
//
praxi
ptr1_is_gtez
  {l:addr}(p: ptr l): [l >= null] void
//
(* ****** ****** *)
//
fun
ptr1_is_null
  {l:addr}(p: ptr l):<> bool (l==null) = "mac#%"
fun
ptr1_isnot_null
  {l:addr}(p: ptr l):<> bool (l > null) = "mac#%"
//
overload ptr_is_null with ptr1_is_null of 10
overload ptr_isnot_null with ptr1_isnot_null of 10
//
(* ****** ****** *)
//
fun
add_ptr1_bsz{l:addr}{i:int}
  (p: ptr l, ofs: size_t (i)):<> ptr (l+i) = "mac#%"
fun
sub_ptr1_bsz{l:addr}{i:int}
  (p: ptr l, ofs: size_t (i)):<> ptr (l-i) = "mac#%"
//
overload add_ptr_bsz with add_ptr1_bsz of 20
overload sub_ptr_bsz with sub_ptr1_bsz of 20
//
(* ****** ****** *)
//
fun
sub_ptr1_ptr1{l1,l2:addr}
  (p1: ptr l1, p2: ptr l2):<> ssize_t (l1-l2) = "mac#%"
//
overload - with sub_ptr1_ptr1 of 20
//
(* ****** ****** *)
//
fun{
a:vt0p
} ptr1_succ{l:addr} (p: ptr l):<> ptr (l+sizeof(a))
fun{
a:vt0p
} ptr1_pred{l:addr} (p: ptr l):<> ptr (l-sizeof(a))
//
overload ptr_succ with ptr1_succ of 10
overload ptr_pred with ptr1_pred of 10
//
(* ****** ****** *)
//
fun{
a:vt0p}{tk:tk
} ptr1_add_gint
  {l:addr}{i:int}
  (p: ptr l, ofs: g1int (tk, i)):<> ptr(l+i*sizeof(a))
fun{
a:vt0p}{tk:tk
} ptr1_add_guint
  {l:addr}{i:int}
  (p: ptr l, ofs: g1uint (tk, i)):<> ptr(l+i*sizeof(a))
//
overload ptr_add with ptr1_add_gint of 20
overload ptr_add with ptr1_add_guint of 20
//
(* ****** ****** *)
//
fun{
a:vt0p}{tk:tk
} ptr1_sub_gint
  {l:addr}{i:int}
  (p: ptr l, ofs: g1int (tk, i)):<> ptr(l-i*sizeof(a))
fun{
a:vt0p}{tk:tk
} ptr1_sub_guint
  {l:addr}{i:int}
  (p: ptr l, ofs: g1uint (tk, i)):<> ptr(l-i*sizeof(a))
//
overload ptr_sub with ptr1_sub_gint of 20
overload ptr_sub with ptr1_sub_guint of 20
//
(* ****** ****** *)

fun lt_ptr1_ptr1
  {l1,l2:addr} (
  p1: ptr (l1), p2: ptr (l2)
) :<> bool (l1 < l2) = "mac#%"
overload < with lt_ptr1_ptr1 of 20
fun lte_ptr1_ptr1
  {l1,l2:addr} (
  p1: ptr (l1), p2: ptr (l2)
) :<> bool (l1 <= l2) = "mac#%"
overload <= with lte_ptr1_ptr1 of 20
fun gt_ptr1_ptr1
  {l1,l2:addr} (
  p1: ptr (l1), p2: ptr (l2)
) :<> bool (l1 > l2) = "mac#%"
overload > with gt_ptr1_ptr1 of 20
fun gte_ptr1_ptr1
  {l1,l2:addr} (
  p1: ptr (l1), p2: ptr (l2)
) :<> bool (l1 >= l2) = "mac#%"
overload >= with gte_ptr1_ptr1 of 20
fun eq_ptr1_ptr1
  {l1,l2:addr} (
  p1: ptr (l1), p2: ptr (l2)
) :<> bool (l1 == l2) = "mac#%"
overload = with eq_ptr1_ptr1 of 20
fun neq_ptr1_ptr1
  {l1,l2:addr} (
  p1: ptr (l1), p2: ptr (l2)
) :<> bool (l1 != l2) = "mac#%"
overload != with neq_ptr1_ptr1 of 20
overload <> with neq_ptr1_ptr1 of 20

fun compare_ptr1_ptr1
  {l1,l2:addr} (p1: ptr l1, p2: ptr l2) :<> int = "mac#%"
overload compare with compare_ptr1_ptr1 of 20

(* ****** ****** *)
//
fun
gt_ptr1_intz{l:addr}
  (p: ptr(l), i: int(0)):<> bool(l > null) = "mac#%"
fun
eq_ptr1_intz{l:addr}
  (p: ptr(l), i: int(0)):<> bool(l== null) = "mac#%"
fun
neq_ptr1_intz{l:addr}
  (p: ptr(l), i: int(0)):<> bool(l > null) = "mac#%"
//
overload > with gt_ptr1_intz of 10
overload = with eq_ptr1_intz of 10
overload != with neq_ptr1_intz of 10
overload <> with neq_ptr1_intz of 10
//
(* ****** ****** *)
//
// HX: implemented in [prelude/DATS/pointer.dats]
//
fun{a:vt0p}
ptr_get{l:addr}
  (pf: !INV(a) @ l >> a?! @ l | p: ptr l):<> a
// end of [ptr_get]

fun{a:vt0p}
ptr_set{l:addr}
  (pf: !a? @ l >> a @ l | p: ptr l, x: INV(a)):<!wrt> void
// end of [ptr_set]

fun{a:vt0p}
ptr_exch{l:addr}
  (pf: !INV(a) @ l | p: ptr l, x: &a >> a):<!wrt> void
// end of [ptr_exch]

(* ****** ****** *)
//
abstype
cptr_vt0ype_addr_type
  (a:vt@ype+, addr) = ptr // HX: for simulating C pointers
//
stadef cptr = cptr_vt0ype_addr_type
stadef cPtr0 (a:vt0p) = [l:addr] cptr (a, l)
stadef cPtr1 (a:vt0p) = [l:addr | l > null] cptr(a, l)
//
castfn
cptr2ptr{a:vt0p}{l:addr} (cp: cptr(a, l)):<> ptr(l)
//
(* ****** ****** *)
//
fun cptr_null{a:vt0p} ():<> cptr(a, null) = "mac#%"
//
castfn cptr_rvar{a:vt0p} (x: &INV(a)):<> cPtr1(a) // read
castfn cptr_wvar{a:vt0p} (x: &a? >> a):<> cPtr1(a) // write
//
(* ****** ****** *)
//
fun
{a:vt0p}
cptr_succ{l:addr}(cp: cptr(a, l)):<> cptr(a, l+sizeof(a))
fun
{a:vt0p}
cptr_pred{l:addr}(cp: cptr(a, l)):<> cptr(a, l-sizeof(a))
//
(* ****** ****** *)
//
fun
cptr_is_null
  {a:vt0p}{l:addr}(cp: cptr(a, l)):<> bool(l==null) = "mac#%"
fun
cptr_isnot_null
  {a:vt0p}{l:addr}(cp: cptr(a, l)):<> bool(l > null) = "mac#%"
//
(* ****** ****** *)
//
fun
gt_cptr_intz
  {a:vt0p}{l:addr}
  (cp: cptr(a, l), i: int(0)):<> bool(l > null) = "mac#%"
//
fun
eq_cptr_intz
  {a:vt0p}{l:addr}
  (cp: cptr(a, l), i: int(0)):<> bool(l== null) = "mac#%"
fun
neq_cptr_intz
  {a:vt0p}{l:addr}
  (cp: cptr(a, l), i: int(0)):<> bool(l > null) = "mac#%"
//
overload > with gt_cptr_intz of 0
overload = with eq_cptr_intz of 0
overload != with neq_cptr_intz of 0
overload <> with neq_cptr_intz of 0
//
(* ****** ****** *)

typedef voidptr (l:addr) = cptr (void, l)
typedef voidptr0 = [l:addr] voidptr (l)
typedef voidptr1 = [l:addr | l > null] voidptr (l)

typedef charptr (l:addr) = cptr (char, l)
typedef charptr0 = [l:addr] charptr (l)
typedef charptr1 = [l:addr | l > null] charptr (l)

typedef constcharptr (l:addr) = charptr (l) // HX: commenting
typedef constcharptr0 = charptr0 // HX: for commenting purpose
typedef constcharptr1 = charptr1 // HX: for commenting purpose

(* ****** ****** *)
//
absprop
is_nullable(a: vt@ype+) // covariant
//
fun{a:vt0p}
ptr_nullize
  (pf: is_nullable (a) | x: &a? >> a):<!wrt> void
fun
ptr_nullize_tsz{a:vt0p}
(
  pf: is_nullable(a) | x: &a? >> a, tsz: sizeof_t(a)
) :<!wrt> void = "mac#%" // end of [ptr_nullize_tsz]
//
(* ****** ****** *)

fun
{a:vt0p}
ptr_alloc((*void*))
  :<> [l:agz] (a? @ l, mfree_gc_v(l) | ptr(l))
// end of [ptr_alloc]

fun
ptr_alloc_tsz
  {a:vt0p}(tsz: sizeof_t(a))
  :<> [l:agz] (a? @ l, mfree_gc_v(l) | ptr(l)) = "mac#%"
// end of [ptr_alloc_tsz]

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

fun
ptr_free{a:t@ype}{l:addr}
  (pfgc: mfree_gc_v(l), pfat: a @ l | p: ptr(l)):<> void = "mac#%"
// end of [ptr_free]

(* ****** ****** *)
//
absvtype
ptrlin_vtype(l:addr) = ptr
//
vtypedef
ptrlin(l:addr) = ptrlin_vtype(l)
//
praxi ptrlin_free{l:addr} (p: ptrlin(l)): void
//
castfn ptr2ptrlin{l:addr} (p: ptr(l)):<> ptrlin(l)
castfn ptrlin2ptr{l:addr} (p: ptrlin(l)):<> ptr(l)
//
(* ****** ****** *)
//
// HX-2015-03-24:
// singleton linear arrayptr
//
absvtype
aptr_vt0ype_addr_type
  (a:vt@ype+, addr) = ptr // HX: for safe ATS pointers
//
stadef aptr = aptr_vt0ype_addr_type
stadef aPtr0 (a:vt0p) = [l:addr] aptr(a, l)
stadef aPtr1 (a:vt0p) = [l:addr | l > null] aptr(a, l)
//
castfn
aptr2ptr{a:vt0p}{l:addr}(ap: !aptr(INV(a), l)):<> ptr(l)
//
(* ****** ****** *)
//
fun
{a:vt0p}
aptr_make_elt(x: a):<!wrt> aPtr1(a)
fun
{a:vt0p}
aptr_getfree_elt{l:agz}(aptr(a, l)):<!wrt> (a)
//
fun
{a:vt0p}
aptr_get_elt
  {l:agz}
  (ap: !aptr(a, l) >> aptr(a?!, l)):<!wrt> (a)
fun
{a:vt0p}
aptr_set_elt
  {l:agz}
  (ap: !aptr(a?, l) >> aptr(a, l), x: a):<!wrt> void
//
fun
{a:vt0p}
aptr_exch_elt
  {l:agz}
  (ap: !aptr(INV(a), l) >> _, x: &(a) >> _):<!wrt> void
//
(*
overload [] with aptr_get_elt // HX: template arg needed
overload [] with aptr_set_elt // HX: template arg needed
*)
//
(* ****** ****** *)
//
fun aptr_null{a:vt0p}():<> aptr(a, null) = "mac#%"
//
fun
aptr_is_null
{a:vt0p}{l:addr}
  (ap: !aptr(INV(a), l)):<> bool(l==null) = "mac#%"
fun
aptr_isnot_null
{a:vt0p}{l:addr}
  (ap: !aptr(INV(a), l)):<> bool(l > null) = "mac#%"
//
overload iseqz with aptr_is_null
overload isneqz with aptr_isnot_null
//
(* ****** ****** *)
//
// HX-2014-05-16:
// A hack to stop buggy compilation
//
fun ptr_as_volatile (p: ptr): void
//
(* ****** ****** *)
//
// overloading for certain symbols
//
overload succ with ptr0_succ
overload succ with ptr1_succ
overload succ with cptr_succ
//
overload pred with ptr0_pred
overload pred with ptr1_pred
overload pred with cptr_pred
//
overload iseqz with ptr0_is_null of 0
overload isneqz with ptr0_isnot_null of 0
//
overload iseqz with ptr1_is_null of 10
overload isneqz with ptr1_isnot_null of 10
//
overload iseqz with cptr_is_null of 10
overload isneqz with cptr_isnot_null of 10
//
(* ****** ****** *)

(* end of [pointer.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/memory.atxt
** Time of generation: Fri Aug 18 03:29:51 2017
*)

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

typedef bytes (n:int) = @[byte][n]
typedef b0ytes (n:int) = @[byte?][n]

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

viewdef bytes_v (l:addr, n:int) = bytes (n) @ l
viewdef b0ytes_v (l:addr, n:int) = b0ytes (n) @ l

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

praxi
b0ytes2bytes
  {l:addr}{n:int} (&b0ytes(n) >> bytes(n)): void
// end of [b0ytes2bytes]
praxi
b0ytes2bytes_v
  {l:addr}{n:int} (pf: b0ytes_v (l, n)): bytes_v (l, n)
// end of [b0ytes2bytes_v]

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

prfun
bytes_v_split
  {l:addr}
  {n:int}{i:nat | i <= n}
  (pf: bytes_v (l, n)): (bytes_v (l, i), bytes_v (l+i, n-i))
// end of [bytes_v_split]

prfun
bytes_v_split_at
  {l:addr}
  {n:int}{i:nat | i <= n}
  (pf: bytes_v (l, n) | i: size_t (i)): (bytes_v (l, i), bytes_v (l+i, n-i))
// end of [bytes_v_split_at]

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

prfun
bytes_v_unsplit
  {l:addr}{n1,n2:int}
  (pf1: bytes_v (l, n1), pf2: bytes_v (l+n1, n2)): bytes_v (l, n1+n2)
// end of [bytes_v_unsplit]

(* ****** ****** *)
//
// HX-2013-08:
// for memory initialization
//
fun minit_gc (): void = "mac#%"
//
(* ****** ****** *)

fun
mfree_gc
  {l:addr}{n:int}
(
  pfat: b0ytes n @ l
, pfgc: mfree_gc_v (l) | ptr l
) :<!wrt> void = "mac#%"

fun
malloc_gc
  {n:int}
(
  bsz: size_t (n)
) :<!wrt>
  [l:agz]
(
  b0ytes n @ l, mfree_gc_v (l) | ptr l
) = "mac#%" // endfun

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

absview memory$free_v (l:addr)

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

fun{
} memory$free
  {l:addr}{n:int}
(
  pfat: b0ytes n @ l
, pfmf: memory$free_v (l) | ptr l
) :<!wrt> void // end-of-fun

fun{
} memory$alloc
  {n:int}
(
  bsz: size_t (n)
) :<!wrt>
  [l:agz]
(
  b0ytes n @ l, memory$free_v (l) | ptr l
) (* end of [memory$alloc] *)

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

(* end of [memory.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/bool.atxt
** Time of generation: Fri Aug 18 03:29:49 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: September, 2011 *)

(* ****** ****** *)
//
castfn g0ofg1_bool (x: Bool):<> bool
castfn g1ofg0_bool (x: bool):<> Bool
//
overload g0ofg1 with g0ofg1_bool // index-erasing
overload g1ofg0 with g1ofg0_bool // index-inducing
//
(* ****** ****** *)
//
fun
int2bool0 (i: int):<> bool = "mac#%"
fun
int2bool1
  {i:int} (i: int i):<> bool(i != 0) = "mac#%"
//
symintr int2bool
overload int2bool with int2bool0 of 0
overload int2bool with int2bool1 of 10
//
fun
bool2int0 (b: bool):<> natLt(2) = "mac#%"
fun
bool2int1
  {b:bool} (b: bool b):<> int(bool2int(b)) = "mac#%"
//
symintr bool2int
overload bool2int with bool2int0 of 0
overload bool2int with bool2int1 of 10
//
(* ****** ****** *)

(*
//
// HX: declared in [prelude/basics_dyn.sats]
//
val true : bool (true) and false : bool (false)
*)

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

(*
** HX-2012-06:
** shortcut version of disjuction and conjuction
** note that these two cannot be declared as functions
*)
macdef || (b1, b2) = (if ,(b1) then true else ,(b2)): bool
macdef && (b1, b2) = (if ,(b1) then ,(b2) else false): bool

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

typedef boolLte (b: bool) = [a: bool | a <= b] bool (a)
typedef boolGte (b: bool) = [a: bool | a >= b] bool (a)

(* ****** ****** *)
//
fun
neg_bool0
  (b: bool):<> bool = "mac#%"
//
overload ~ with neg_bool0 of 0
overload not with neg_bool0 of 0
//
(* ****** ****** *)
//
fun
add_bool0_bool0
  (b1: bool, b2: bool):<> bool = "mac#%"
fun
mul_bool0_bool0
  (b1: bool, b2: bool):<> bool = "mac#%"
//
overload + with add_bool0_bool0 of 0
overload * with mul_bool0_bool0 of 0
//
(* ****** ****** *)
//
fun
xor_bool0_bool0
  (b1: bool, b2: bool):<> bool = "mac#%"
//
overload xor with xor_bool0_bool0 of 0
//
(* ****** ****** *)

fun
lt_bool0_bool0
  (b1: bool, b2: bool):<> bool = "mac#%"
overload < with lt_bool0_bool0 of 0
fun
lte_bool0_bool0
  (b1: bool, b2: bool):<> bool = "mac#%"
overload <= with lte_bool0_bool0 of 0

fun
gt_bool0_bool0
  (b1: bool, b2: bool):<> bool = "mac#%"
overload > with gt_bool0_bool0 of 0
fun
gte_bool0_bool0
  (b1: bool, b2: bool):<> bool = "mac#%"
overload >= with gte_bool0_bool0 of 0

fun
eq_bool0_bool0
  (b1: bool, b2: bool):<> bool = "mac#%"
overload = with eq_bool0_bool0 of 0
fun
neq_bool0_bool0
  (b1: bool, b2: bool):<> bool = "mac#%"
overload != with neq_bool0_bool0 of 0
overload <> with neq_bool0_bool0 of 0

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

fun compare_bool0_bool0
  (b1: bool, b2: bool):<> Sgn = "mac#%"
overload compare with compare_bool0_bool0

(* ****** ****** *)
//
// HX:
// return is statically allocated
//
fun
bool2string(b: bool):<> string = "mac#%"
//
(* ****** ****** *)
//
fun print_bool (x: bool): void = "mac#%"
fun prerr_bool (x: bool): void = "mac#%"
fun fprint_bool : fprint_type (bool) = "mac#%"
//
overload print with print_bool
overload prerr with prerr_bool
overload fprint with fprint_bool
//
(* ****** ****** *)
//
fun
neg_bool1
  {b:bool}
  (b: bool b):<> bool (~b) = "mac#%"
//
overload ~ with neg_bool1 of 10
overload not with neg_bool1 of 10
//
(* ****** ****** *)

fun
add_bool0_bool1
  {b2:bool}
(
  b1: bool, b2: bool b2
) :<> [b1:bool] bool(b1 || b2) = "mac#%"
overload + with add_bool0_bool1 of 10

fun
add_bool1_bool0
  {b1:bool}
(
  b1: bool b1, b2: bool
) :<> [b2:bool] bool(b1 || b2) = "mac#%"
overload + with add_bool1_bool0 of 10

fun
add_bool1_bool1
  {b1,b2:bool}
  (b1: bool b1, b2: bool b2):<> bool(b1 || b2) = "mac#%"
overload + with add_bool1_bool1 of 20

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

fun
mul_bool0_bool1
  {b2:bool}
(
  b1: bool, b2: bool b2
) :<> [b1:bool] bool(b1 && b2) = "mac#%"
overload * with mul_bool0_bool1 of 10

fun
mul_bool1_bool0
  {b1:bool}
(
  b1: bool b1, b2: bool
) :<> [b2:bool] bool(b1 && b2) = "mac#%"
overload * with mul_bool1_bool0 of 10

fun
mul_bool1_bool1
  {b1,b2:bool}
  (b1: bool b1, b2: bool b2):<> bool(b1 && b2) = "mac#%"
overload * with mul_bool1_bool1 of 20

(* ****** ****** *)
//
fun
xor_bool1_bool1
  {b1,b2:bool}
  (b1: bool b1, b2: bool b2):<> bool((b1)==(~b2)) = "mac#%"
//
overload xor with xor_bool1_bool1 of 20
//
(* ****** ****** *)

//
// (b1 < b2) == (~b1 && b2)
//
fun
lt_bool1_bool1 {b1,b2:bool}
  (b1: bool (b1), b2: bool (b2)) :<> bool (b1 < b2) = "mac#%"
overload < with lt_bool1_bool1 of 20
//
// (b1 <= b2) == (~b1 || b2)
//
fun
lte_bool1_bool1 {b1,b2:bool}
  (b1: bool (b1), b2: bool (b2)) :<> bool (b1 <= b2) = "mac#%"
overload <= with lte_bool1_bool1 of 20
//
// (b1 > b2) == (b1 && ~b2)
//
fun
gt_bool1_bool1 {b1,b2:bool}
  (b1: bool (b1), b2: bool (b2)) :<> bool (b1 > b2) = "mac#%"
overload > with gt_bool1_bool1 of 20
//
// (b1 >= b2) == (b1 || ~b2)
//
fun
gte_bool1_bool1 {b1,b2:bool}
  (b1: bool (b1), b2: bool (b2)) :<> bool (b1 >= b2) = "mac#%"
overload >= with gte_bool1_bool1 of 20

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

fun
eq_bool1_bool1 {b1,b2:bool}
  (b1: bool (b1), b2: bool (b2)) :<> bool (b1 == b2) = "mac#%"
overload = with eq_bool1_bool1 of 20
fun
neq_bool1_bool1 {b1,b2:bool}
  (b1: bool (b1), b2: bool (b2)) :<> bool (b1 != b2) = "mac#%"
overload != with neq_bool1_bool1 of 20
overload <> with neq_bool1_bool1 of 20

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

fun
compare_bool1_bool1
  {b1,b2:bool} // HX: this one is a function
(
 b1: bool b1, b2: bool b2
) :<> int (bool2int(b1) - bool2int(b2)) = "mac#%"
overload compare with compare_bool1_bool1 of 20

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

(* end of [bool.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)
(* ****** ****** *)

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/char.atxt
** Time of generation: Fri Aug 18 03:29:49 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: September, 2011 *)

(* ****** ****** *)
//
praxi
lemma_char_size
(
// argumentless
) : [sizeof(char)==sizeof(byte)] void
praxi
lemma_schar_size
(
// argumentless
) : [sizeof(schar)==sizeof(byte)] void
praxi
lemma_uchar_size
(
// argumentless
) : [sizeof(uchar)==sizeof(byte)] void
//
(* ****** ****** *)
//
castfn char2schar0(c: char):<> schar
castfn schar2char0(c: schar):<> char
//
castfn char2uchar0(c: char):<> uchar
castfn uchar2char0(c: uchar):<> char
//
(* ****** ****** *)
//
fun int2char0(i: int):<> char = "mac#%"
fun int2schar0(i: int):<> schar = "mac#%"
fun int2uchar0(i: int):<> uchar = "mac#%"
//
fun uint2uchar0(u: uint):<> uchar = "mac#%"
//
(* ****** ****** *)

fun char2int0(c: char):<> int = "mac#%"
fun schar2int0(c: schar):<> int = "mac#%"
fun uchar2int0(c: uchar):<> int = "mac#%"

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

fun char2uint0(c: char):<> uint = "mac#%"
fun schar2uint0(c: schar):<> uint = "mac#%"
fun uchar2uint0(c: uchar):<> uint = "mac#%"

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

fun char2u2int0(c: char):<> int = "mac#%"
fun char2u2uint0(c: char):<> uint = "mac#%"

(* ****** ****** *)
//
fun
char0_iseqz(c: char):<> bool = "mac#%"
fun
char0_isneqz(c: char):<> bool = "mac#%"
//
overload iseqz with char0_iseqz of 0
overload isneqz with char0_isneqz of 0
//
(* ****** ****** *)
//
fun add_char0_int0
  (c: char, i: int):<> char = "mac#%"
fun sub_char0_int0
  (c: char, i: int):<> char = "mac#%"
fun sub_char0_char0
  (c1: char, c2: char):<> int = "mac#%"
//
overload + with add_char0_int0 of 0
overload - with sub_char0_int0 of 0
overload - with sub_char0_char0 of 0
//
(* ****** ****** *)

fun lt_char0_char0
  (c1: char, c2: char):<> bool = "mac#%"
overload < with lt_char0_char0 of 0
fun lte_char0_char0
  (c1: char, c2: char):<> bool = "mac#%"
overload <= with lte_char0_char0 of 0

fun gt_char0_char0
  (c1: char, c2: char):<> bool = "mac#%"
overload > with gt_char0_char0 of 0
fun gte_char0_char0
  (c1: char, c2: char):<> bool = "mac#%"
overload >= with gte_char0_char0 of 0

fun eq_char0_char0
  (c1: char, c2: char):<> bool = "mac#%"
overload = with eq_char0_char0 of 0
fun neq_char0_char0
  (c1: char, c2: char):<> bool = "mac#%"
overload != with neq_char0_char0 of 0
overload <> with neq_char0_char0 of 0

fun compare_char0_char0
  (c1: char, c2: char):<> int = "mac#%"
overload compare with compare_char0_char0 of 0

(* ****** ****** *)
//
castfn g0ofg1_char(c: Char):<> char
castfn g1ofg0_char(c: char):<> Char
//
overload g0ofg1 with g0ofg1_char // index-erasing
overload g1ofg0 with g1ofg0_char // index-inducing
//
(* ****** ****** *)
//
castfn
char2schar1
  {c:int}(c: char(c)):<> schar(c)
castfn
schar2char1
  {c:int}(c: schar(c)):<> char(c)
//
castfn
char2uchar1
  {c:int}(c: char(c)):<> uchar(i2u8(c))
castfn
uchar2char1
  {c:int}(c: uchar(c)):<> char(u2i8(c))
//
(* ****** ****** *)
//
fun
char2int1
  {c:int}(c: char(c)):<> int(c) = "mac#%"
fun
schar2int1
  {c:int}(c: schar(c)):<> int(c) = "mac#%"
fun
uchar2int1
  {c:int}(c: uchar(c)):<> int(c) = "mac#%"
//
(* ****** ****** *)
//
fun
char1_iseqz
  {c:int}(c: char(c)):<> bool(c == 0) = "mac#%"
fun
char1_isneqz
  {c:int}(c: char(c)):<> bool(c != 0) = "mac#%"
//
overload iseqz with char1_iseqz of 10
overload isneqz with char1_isneqz of 10
//
(* ****** ****** *)

fun
lt_char1_char1
  {c1,c2:int}
  (c1: char(c1), c2: char(c2)):<> bool(c1 < c2) = "mac#%"
overload < with lt_char1_char1 of 20
fun
lte_char1_char1
  {c1,c2:int}
  (c1: char(c1), c2: char(c2)):<> bool(c1 <= c2) = "mac#%"
overload <= with lte_char1_char1 of 20

fun
gt_char1_char1
  {c1,c2:int}
  (c1: char(c1), c2: char(c2)):<> bool(c1 > c2) = "mac#%"
overload > with gt_char1_char1 of 20
fun
gte_char1_char1
  {c1,c2:int}
  (c1: char(c1), c2: char(c2)):<> bool(c1 >= c2) = "mac#%"
overload >= with gte_char1_char1 of 20

fun
eq_char1_char1
  {c1,c2:int}
  (c1: char(c1), c2: char(c2)):<> bool(c1 == c2) = "mac#%"
overload = with eq_char1_char1 of 20
fun
neq_char1_char1
  {c1,c2:int}
  (c1: char(c1), c2: char(c2)):<> bool(c1 != c2) = "mac#%"
overload != with neq_char1_char1 of 20
overload <> with neq_char1_char1 of 20

fun compare_char1_char1
  {c1,c2:int}
  (c1: char c1, c2: char c2) :<> int(c1-c2) = "mac#%"
overload compare with compare_char1_char1 of 20

(* ****** ****** *)
//
fun eq_char0_int0 : (char, int) -<fun0> bool = "mac#%"
fun eq_int0_char0 : (int, char) -<fun0> bool = "mac#%"
overload = with eq_char0_int0 of 0
overload = with eq_int0_char0 of 0
fun neq_char0_int0 : (char, int) -<fun0> bool = "mac#%"
fun neq_int0_char0 : (int, char) -<fun0> bool = "mac#%"
overload != with neq_char0_int0 of 0
overload <> with neq_char0_int0 of 0
overload != with neq_int0_char0 of 0
overload <> with neq_int0_char0 of 0
//
fun compare_char0_int0 : (char, int) -<fun0> int = "mac#%"
fun compare_int0_char0 : (int, char) -<fun0> int = "mac#%"
overload compare with compare_char0_int0
overload compare with compare_int0_char0
//
(* ****** ****** *)
//
// unsigned characters
//
(* ****** ****** *)

fun lt_uchar0_uchar0
  (c1: uchar, c2: uchar):<> bool = "mac#%"
overload < with lt_uchar0_uchar0 of 0
fun lte_uchar0_uchar0
  (c1: uchar, c2: uchar):<> bool = "mac#%"
overload <= with lte_uchar0_uchar0 of 0

fun gt_uchar0_uchar0
  (c1: uchar, c2: uchar):<> bool = "mac#%"
overload > with gt_uchar0_uchar0 of 0
fun gte_uchar0_uchar0
  (c1: uchar, c2: uchar):<> bool = "mac#%"
overload >= with gte_uchar0_uchar0 of 0

fun eq_uchar0_uchar0
  (c1: uchar, c2: uchar):<> bool = "mac#%"
overload = with eq_uchar0_uchar0 of 0
fun neq_uchar0_uchar0
  (c1: uchar, c2: uchar):<> bool = "mac#%"
overload != with neq_uchar0_uchar0 of 0
overload <> with neq_uchar0_uchar0 of 0

fun compare_uchar0_uchar0
  (c1: uchar, c2: uchar):<> int = "mac#%"
overload compare with compare_uchar0_uchar0 of 0

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

fun
lt_uchar1_uchar1
  {c1,c2:int}
  (c1: uchar(c1), c2: uchar(c2)) :<> bool(c1 < c2) = "mac#%"
overload < with lt_uchar1_uchar1 of 20
fun
lte_uchar1_uchar1
  {c1,c2:int}
  (c1: uchar(c1), c2: uchar(c2)) :<> bool(c1 <= c2) = "mac#%"
overload <= with lte_uchar1_uchar1 of 20

fun
gt_uchar1_uchar1
  {c1,c2:int}
  (c1: uchar(c1), c2: uchar(c2)) :<> bool(c1 > c2) = "mac#%"
overload > with gt_uchar1_uchar1 of 20
fun
gte_uchar1_uchar1
  {c1,c2:int}
  (c1: uchar(c1), c2: uchar(c2)) :<> bool(c1 >= c2) = "mac#%"
overload >= with gte_uchar1_uchar1 of 20

fun
eq_uchar1_uchar1
  {c1,c2:int}
  (c1: uchar(c1), c2: uchar(c2)) :<> bool(c1 == c2) = "mac#%"
overload = with eq_uchar1_uchar1 of 20
fun
neq_uchar1_uchar1
  {c1,c2:int}
  (c1: uchar(c1), c2: uchar(c2)) :<> bool(c1 != c2) = "mac#%"
overload != with neq_uchar1_uchar1 of 20
overload <> with neq_uchar1_uchar1 of 20

fun compare_uchar1_uchar1
  {c1,c2:int}
  (c1: uchar c1, c2: uchar c2) :<> int(c1-c2) = "mac#%"
overload compare with compare_uchar1_uchar1 of 20

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

sortdef tk = tkind

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

fun{tk:tk}
g0int_of_char(c: char):<> g0int(tk)
fun{tk:tk}
g0int_of_schar(c: schar):<> g0int(tk)
fun{tk:tk}
g0int_of_uchar(c: uchar):<> g0int(tk)

fun{tk:tk}
g0uint_of_uchar(c: uchar):<> g0uint(tk)

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

fun{tk:tk}
g1int_of_char1 // c:int8
  {c:int} (c: char(c)):<> g1int(tk, c)
// end of [g1int_of_char1]
fun{tk:tk}
g1int_of_schar1 // c:int8
  {c:int} (c: schar(c)):<> g1int(tk, c)
// end of [g1int_of_schar1]
fun{tk:tk}
g1int_of_uchar1 // c:uint8
  {c:int} (c: uchar(c)):<> g1int(tk, c)
// end of [g1int_of_uchar1]

(*
** HX: g1uint_of_schar1: schar -> int -> uint
*)
fun{tk:tk}
g1uint_of_uchar1
  {c:int} (c: uchar(c)):<> g1uint(tk, c)
// end of [g1uint_of_uchar1]

(* ****** ****** *)
//
// HX:
// return is dynamically allocated
//
fun{}
char2string(c: char):<> string
fun{}
char2strptr(c: char):<!wrt> Strptr1
//
(* ****** ****** *)

fun print_char(x: char): void = "mac#%"
fun prerr_char(x: char): void = "mac#%"
overload print with print_char
overload prerr with prerr_char
fun fprint_char : fprint_type (char) = "mac#%"
overload fprint with fprint_char
fun print_schar(x: schar): void = "mac#%"
fun prerr_schar(x: schar): void = "mac#%"
overload print with print_schar
overload prerr with prerr_schar
fun fprint_schar : fprint_type (schar) = "mac#%"
overload fprint with fprint_schar
fun print_uchar(x: uchar): void = "mac#%"
fun prerr_uchar(x: uchar): void = "mac#%"
overload print with print_uchar
overload prerr with prerr_uchar
fun fprint_uchar : fprint_type (uchar) = "mac#%"
overload fprint with fprint_uchar

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

fun isalpha_int(c: int):<> bool = "mac#%"
fun isalpha_char(c: char):<> bool = "mac#%"
//
symintr isalpha
overload isalpha with isalpha_int of 0
overload isalpha with isalpha_char of 0
//
fun isalnum_int(c: int):<> bool = "mac#%"
fun isalnum_char(c: char):<> bool = "mac#%"
//
symintr isalnum
overload isalnum with isalnum_int of 0
overload isalnum with isalnum_char of 0
//

fun isascii_int(c: int):<> bool = "mac#%"
fun isascii_char(c: char):<> bool = "mac#%"
//
symintr isascii
overload isascii with isascii_int of 0
overload isascii with isascii_char of 0
//

fun isblank_int(c: int):<> bool = "mac#%"
fun isblank_char(c: char):<> bool = "mac#%"
//
symintr isblank
overload isblank with isblank_int of 0
overload isblank with isblank_char of 0
//
fun isspace_int(c: int):<> bool = "mac#%"
fun isspace_char(c: char):<> bool = "mac#%"
//
symintr isspace
overload isspace with isspace_int of 0
overload isspace with isspace_char of 0
//

fun iscntrl_int(c: int):<> bool = "mac#%"
fun iscntrl_char(c: char):<> bool = "mac#%"
//
symintr iscntrl
overload iscntrl with iscntrl_int of 0
overload iscntrl with iscntrl_char of 0
//

fun isdigit_int(c: int):<> bool = "mac#%"
fun isdigit_char(c: char):<> bool = "mac#%"
//
symintr isdigit
overload isdigit with isdigit_int of 0
overload isdigit with isdigit_char of 0
//
fun isxdigit_int(c: int):<> bool = "mac#%"
fun isxdigit_char(c: char):<> bool = "mac#%"
//
symintr isxdigit
overload isxdigit with isxdigit_int of 0
overload isxdigit with isxdigit_char of 0
//

fun isgraph_int(c: int):<> bool = "mac#%"
fun isgraph_char(c: char):<> bool = "mac#%"
//
symintr isgraph
overload isgraph with isgraph_int of 0
overload isgraph with isgraph_char of 0
//
fun isprint_int(c: int):<> bool = "mac#%"
fun isprint_char(c: char):<> bool = "mac#%"
//
symintr isprint
overload isprint with isprint_int of 0
overload isprint with isprint_char of 0
//
fun ispunct_int(c: int):<> bool = "mac#%"
fun ispunct_char(c: char):<> bool = "mac#%"
//
symintr ispunct
overload ispunct with ispunct_int of 0
overload ispunct with ispunct_char of 0
//

fun islower_int(c: int):<> bool = "mac#%"
fun islower_char(c: char):<> bool = "mac#%"
//
symintr islower
overload islower with islower_int of 0
overload islower with islower_char of 0
//
fun isupper_int(c: int):<> bool = "mac#%"
fun isupper_char(c: char):<> bool = "mac#%"
//
symintr isupper
overload isupper with isupper_int of 0
overload isupper with isupper_char of 0
//

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

fun toascii (c: int):<> int = "mac#%"

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

symintr tolower
fun tolower_int(c: int):<> int = "mac#%"
fun tolower_char(c: char):<> char = "mac#%"
overload tolower with tolower_int
overload tolower with tolower_char

symintr toupper
fun toupper_int(c: int):<> int = "mac#%"
fun toupper_char(c: char):<> char = "mac#%"
overload toupper with toupper_int
overload toupper with toupper_char

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

fun int2digit (i: intBtw(0, 10)): char = "mac#%"
fun int2xdigit (i: intBtw(0, 16)): char = "mac#%"
fun int2xxdigit (i: intBtw(0, 16)): char = "mac#%"

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

symintr c2uc
overload c2uc with char2uchar0 of 0
overload c2uc with char2uchar1 of 10
symintr uc2c
overload uc2c with uchar2char0 of 0
overload uc2c with uchar2char1 of 10

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

symintr char2i
overload char2i with char2int0 of 0
symintr char2ui
overload char2ui with char2uint0 of 0
symintr uchar2i
overload uchar2i with uchar2int0 of 0
symintr uchar2ui
overload uchar2ui with uchar2uint0 of 0

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

symintr char2u2i
overload char2u2i with char2u2int0 of 0
symintr char2u2ui
overload char2u2ui with char2u2uint0 of 0

(* ****** ****** *)
//
fun int2byte0(i: int): byte = "mac#%"
fun byte2int0(b: byte):<> int = "mac#%"
//
fun uint2byte0(u: uint): byte = "mac#%"
fun byte2uint0(b: byte):<> uint = "mac#%"
//
symintr byte2i
overload byte2i with byte2int0 of 0
symintr i2byte
overload i2byte with int2byte0 of 0
//
symintr byte2ui
overload byte2i with byte2uint0 of 0
symintr ui2byte
overload i2byte with uint2byte0 of 0
//
(* ****** ****** *)

(* end of [char.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: September, 2011 *)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/float.atxt
** Time of generation: Thu Sep 14 11:48:57 2017
*)

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

stadef fltknd = float_kind
stadef dblknd = double_kind
stadef ldblknd = ldouble_kind

(* ****** ****** *)
//
fun
{tk1,tk2:tk}
g0int2float(x: g0int(tk1)):<> g0float(tk2)
//
fun
g0int2float_int_float(x: int):<> float = "mac#%"
fun
g0int2float_int_double(x: int):<> double = "mac#%"
fun
g0int2float_lint_double(x: lint):<> double = "mac#%"
//
(* ****** ****** *)
//
fun
{tk1,tk2:tk}
g0float2int(x: g0float(tk1)):<> g0int(tk2)
//
fun
g0float2int_float_int(x: float):<> int = "mac#%"
fun
g0float2int_float_lint(x: float):<> lint = "mac#%"
fun
g0float2int_double_int(x: double):<> int = "mac#%"
fun
g0float2int_double_lint(x: double):<> lint = "mac#%"
fun
g0float2int_double_llint(x: double):<> llint = "mac#%"
//
(* ****** ****** *)
//
fun
{tk1,tk2:tk}
g0float2float(x: g0float(tk1)):<> g0float(tk2)
//
fun
g0float2float_float_float(x: float):<> float = "mac#%"
fun
g0float2float_float_double(x: float):<> double = "mac#%"
fun
g0float2float_double_float(x: double):<> float = "mac#%"
fun
g0float2float_double_double(x: double):<> double = "mac#%"
//
(* ****** ****** *)
//
fun
{tk:tk}
g0string2float(rep: NSH(string)):<> g0float(tk)
//
fun
g0string2float_double(rep: NSH(string)):<> double = "mac#%"
//
(* ****** ****** *)
//
typedef
g0float_uop_type
  (tk:tk) =
  g0float(tk) -<fun0> g0float(tk)
//
(* ****** ****** *)
//
fun
{tk:tk}
g0float_abs : g0float_uop_type(tk)
fun
{tk:tk}
g0float_neg : g0float_uop_type(tk)
//
overload abs with g0float_abs of 0
overload ~ with g0float_neg of 0 // ~ for uminus
overload neg with g0float_neg of 0
//
(* ****** ****** *)
//
fun
{tk:tk}
g0float_succ : g0float_uop_type(tk)
fun
{tk:tk}
g0float_pred : g0float_uop_type(tk)
//
overload succ with g0float_succ of 0
overload pred with g0float_pred of 0
//
(* ****** ****** *)
//
typedef
g0float_aop_type
  (tk:tk) =
  (g0float(tk), g0float(tk)) -<fun0> g0float(tk)
// end of [g0float_aop_type]
//
(* ****** ****** *)
//
fun
{tk:tk}
g0float_add : g0float_aop_type(tk)
overload + with g0float_add of 0
fun
{tk:tk}
g0float_sub : g0float_aop_type(tk)
overload - with g0float_sub of 0
fun
{tk:tk}
g0float_mul : g0float_aop_type(tk)
overload * with g0float_mul of 0
fun
{tk:tk}
g0float_div : g0float_aop_type(tk)
overload / with g0float_div of 0
fun
{tk:tk}
g0float_mod : g0float_aop_type(tk)
overload % with g0float_mod of 0
overload mod with g0float_mod of 0
//
(* ****** ****** *)
//
fun
{tk:tk}
g0float_isltz(g0float(tk)):<> bool
fun
{tk:tk}
g0float_isltez(g0float(tk)):<> bool
//
overload isltz with g0float_isltz of 0
overload isltez with g0float_isltez of 0
//
fun
{tk:tk}
g0float_isgtz(g0float(tk)):<> bool
fun
{tk:tk}
g0float_isgtez(g0float(tk)):<> bool
//
overload isgtz with g0float_isgtz of 0
overload isgtez with g0float_isgtez of 0
//
fun
{tk:tk}
g0float_iseqz(g0float(tk)):<> bool
fun
{tk:tk}
g0float_isneqz(g0float(tk)):<> bool
//
overload iseqz with g0float_iseqz of 0
overload isneqz with g0float_isneqz of 0
//
(* ****** ****** *)
//
typedef
g0float_cmp_type
  (tk:tk) =
  (g0float(tk), g0float(tk)) -<fun0> bool
// end of [g0float_cmp_type]
//
(* ****** ****** *)
//
fun
{tk:tk}
g0float_lt : g0float_cmp_type(tk)
overload < with g0float_lt of 0
fun
{tk:tk}
g0float_lte : g0float_cmp_type(tk)
overload <= with g0float_lte of 0
fun
{tk:tk}
g0float_gt : g0float_cmp_type(tk)
overload > with g0float_gt of 0
fun
{tk:tk}
g0float_gte : g0float_cmp_type(tk)
overload >= with g0float_gte of 0
fun
{tk:tk}
g0float_eq : g0float_cmp_type(tk)
overload = with g0float_eq of 0
fun
{tk:tk}
g0float_neq : g0float_cmp_type(tk)
overload != with g0float_neq of 0
overload <> with g0float_neq of 0
//
(* ****** ****** *)
//
typedef
g0float_compare_type
  (tk:tk) =
  (g0float(tk), g0float(tk)) -<fun0> int
// end of [g0float_compare_type]
//
(* ****** ****** *)
//
fun
{tk:tk}
g0float_compare
  : g0float_compare_type(tk)
//
overload compare with g0float_compare of 0
//
(* ****** ****** *)
//
fun
{tk:tk}
g0float_max : g0float_aop_type(tk)
fun
{tk:tk}
g0float_min : g0float_aop_type(tk)
//
overload max with g0float_max of 0
overload min with g0float_min of 0
//
(* ****** ****** *)

fun g0float_neg_float
  : g0float_uop_type(fltknd) = "mac#%"
fun g0float_abs_float
  : g0float_uop_type(fltknd) = "mac#%"

fun g0float_succ_float
  : g0float_uop_type(fltknd) = "mac#%"
fun g0float_pred_float
  : g0float_uop_type(fltknd) = "mac#%"

fun g0float_add_float
  : g0float_aop_type(fltknd) = "mac#%"
fun g0float_sub_float
  : g0float_aop_type(fltknd) = "mac#%"
fun g0float_mul_float
  : g0float_aop_type(fltknd) = "mac#%"
fun g0float_div_float
  : g0float_aop_type(fltknd) = "mac#%"
fun g0float_mod_float
  : g0float_aop_type(fltknd) = "mac#%"

fun g0float_lt_float
  : g0float_cmp_type(fltknd) = "mac#%"
fun g0float_lte_float
  : g0float_cmp_type(fltknd) = "mac#%"
fun g0float_gt_float
  : g0float_cmp_type(fltknd) = "mac#%"
fun g0float_gte_float
  : g0float_cmp_type(fltknd) = "mac#%"
fun g0float_eq_float
  : g0float_cmp_type(fltknd) = "mac#%"
fun g0float_neq_float
  : g0float_cmp_type(fltknd) = "mac#%"

fun g0float_compare_float
  : g0float_compare_type(fltknd) = "mac#%"

fun g0float_max_float
  : g0float_aop_type(fltknd) = "mac#%"
fun g0float_min_float
  : g0float_aop_type(fltknd) = "mac#%"

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

fun g0float_neg_double
  : g0float_uop_type(dblknd) = "mac#%"
fun g0float_abs_double
  : g0float_uop_type(dblknd) = "mac#%"

fun g0float_succ_double
  : g0float_uop_type(dblknd) = "mac#%"
fun g0float_pred_double
  : g0float_uop_type(dblknd) = "mac#%"

fun g0float_add_double
  : g0float_aop_type(dblknd) = "mac#%"
fun g0float_sub_double
  : g0float_aop_type(dblknd) = "mac#%"
fun g0float_mul_double
  : g0float_aop_type(dblknd) = "mac#%"
fun g0float_div_double
  : g0float_aop_type(dblknd) = "mac#%"
fun g0float_mod_double
  : g0float_aop_type(dblknd) = "mac#%"

fun g0float_lt_double
  : g0float_cmp_type(dblknd) = "mac#%"
fun g0float_lte_double
  : g0float_cmp_type(dblknd) = "mac#%"
fun g0float_gt_double
  : g0float_cmp_type(dblknd) = "mac#%"
fun g0float_gte_double
  : g0float_cmp_type(dblknd) = "mac#%"
fun g0float_eq_double
  : g0float_cmp_type(dblknd) = "mac#%"
fun g0float_neq_double
  : g0float_cmp_type(dblknd) = "mac#%"

fun g0float_compare_double
  : g0float_compare_type(dblknd) = "mac#%"

fun g0float_max_double
  : g0float_aop_type(dblknd) = "mac#%"
fun g0float_min_double
  : g0float_aop_type(dblknd) = "mac#%"

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

fun g0float_neg_ldouble
  : g0float_uop_type(ldblknd) = "mac#%"
fun g0float_abs_ldouble
  : g0float_uop_type(ldblknd) = "mac#%"

fun g0float_succ_ldouble
  : g0float_uop_type(ldblknd) = "mac#%"
fun g0float_pred_ldouble
  : g0float_uop_type(ldblknd) = "mac#%"

fun g0float_add_ldouble
  : g0float_aop_type(ldblknd) = "mac#%"
fun g0float_sub_ldouble
  : g0float_aop_type(ldblknd) = "mac#%"
fun g0float_mul_ldouble
  : g0float_aop_type(ldblknd) = "mac#%"
fun g0float_div_ldouble
  : g0float_aop_type(ldblknd) = "mac#%"
fun g0float_mod_ldouble
  : g0float_aop_type(ldblknd) = "mac#%"

fun g0float_lt_ldouble
  : g0float_cmp_type(ldblknd) = "mac#%"
fun g0float_lte_ldouble
  : g0float_cmp_type(ldblknd) = "mac#%"
fun g0float_gt_ldouble
  : g0float_cmp_type(ldblknd) = "mac#%"
fun g0float_gte_ldouble
  : g0float_cmp_type(ldblknd) = "mac#%"
fun g0float_eq_ldouble
  : g0float_cmp_type(ldblknd) = "mac#%"
fun g0float_neq_ldouble
  : g0float_cmp_type(ldblknd) = "mac#%"

fun g0float_compare_ldouble
  : g0float_compare_type(ldblknd) = "mac#%"

fun g0float_max_ldouble
  : g0float_aop_type(ldblknd) = "mac#%"
fun g0float_min_ldouble
  : g0float_aop_type(ldblknd) = "mac#%"

(* ****** ****** *)
//
fun print_float (float): void = "mac#%"
fun prerr_float (float): void = "mac#%"
fun fprint_float : fprint_type (float) = "mac#%"
overload print with print_float
overload prerr with prerr_float
overload fprint with fprint_float
//
fun print_double (double): void = "mac#%"
fun prerr_double (double): void = "mac#%"
fun fprint_double : fprint_type (double) = "mac#%"
overload print with print_double
overload prerr with prerr_double
overload fprint with fprint_double
//
fun print_ldouble (ldouble): void = "mac#%"
fun prerr_ldouble (ldouble): void = "mac#%"
fun fprint_ldouble : fprint_type (ldouble) = "mac#%"
overload print with print_ldouble
overload prerr with prerr_ldouble
overload fprint with fprint_ldouble
//
(* ****** ****** *)
//
fun
add_int_float
  (int, float):<> float = "mac#%"
fun
add_float_int
  (float, int):<> float = "mac#%"
//
fun
add_int_double
  (int, double):<> double = "mac#%"
fun
add_double_int
  (double, int):<> double = "mac#%"
//
overload + with add_int_float of 0
overload + with add_float_int of 0
overload + with add_int_double of 0
overload + with add_double_int of 0
//
(* ****** ****** *)
//
fun
sub_int_float
  (int, float):<> float = "mac#%"
fun
sub_float_int
  (float, int):<> float = "mac#%"
//
fun
sub_int_double
  (int, double):<> double = "mac#%"
fun
sub_double_int
  (double, int):<> double = "mac#%"
//
overload - with sub_int_float of 0
overload - with sub_float_int of 0
overload - with sub_int_double of 0
overload - with sub_double_int of 0
//
(* ****** ****** *)
//
fun
mul_int_float
  (int, float):<> float = "mac#%"
fun
mul_float_int
  (float, int):<> float = "mac#%"
//
fun
mul_int_double
  (int, double):<> double = "mac#%"
fun
mul_double_int
  (double, int):<> double = "mac#%"
//
overload * with mul_int_float of 0
overload * with mul_float_int of 0
overload * with mul_int_double of 0
overload * with mul_double_int of 0
//
(* ****** ****** *)
//
fun
div_int_float
  (int, float):<> float = "mac#%"
fun
div_float_int
  (float, int):<> float = "mac#%"
//
fun
div_int_double
  (int, double):<> double = "mac#%"
fun
div_double_int
  (double, int):<> double = "mac#%"
//
overload / with div_int_float of 0
overload / with div_float_int of 0
overload / with div_int_double of 0
overload / with div_double_int of 0
//
(* ****** ****** *)
//
fun
lt_int_float
  (int, float):<> bool = "mac#%"
fun
lt_float_int
  (float, int):<> bool = "mac#%"
fun
lt_int_double
  (int, double):<> bool = "mac#%"
fun
lt_double_int
  (double, int):<> bool = "mac#%"
//
overload < with lt_int_float of 0
overload < with lt_float_int of 0
overload < with lt_int_double of 0
overload < with lt_double_int of 0
//
fun
lte_int_float
  (int, float):<> bool = "mac#%"
fun
lte_float_int
  (float, int):<> bool = "mac#%"
fun
lte_int_double
  (int, double):<> bool = "mac#%"
fun
lte_double_int
  (double, int):<> bool = "mac#%"
//
overload <= with lte_int_float of 0
overload <= with lte_float_int of 0
overload <= with lte_int_double of 0
overload <= with lte_double_int of 0
//
(* ****** ****** *)
//
fun
gt_int_float
  (int, float):<> bool = "mac#%"
fun
gt_float_int
  (float, int):<> bool = "mac#%"
fun
gt_int_double
  (int, double):<> bool = "mac#%"
fun
gt_double_int
  (double, int):<> bool = "mac#%"
//
overload > with gt_int_float of 0
overload > with gt_float_int of 0
overload > with gt_int_double of 0
overload > with gt_double_int of 0
//
fun
gte_int_float
  (int, float):<> bool = "mac#%"
fun
gte_float_int
  (float, int):<> bool = "mac#%"
fun
gte_int_double
  (int, double):<> bool = "mac#%"
fun
gte_double_int
  (double, int):<> bool = "mac#%"
//
overload >= with gte_int_float of 0
overload >= with gte_float_int of 0
overload >= with gte_int_double of 0
overload >= with gte_double_int of 0
//
(* ****** ****** *)
//
fun
eq_int_float
  (int, float):<> bool = "mac#%"
fun
eq_float_int
  (float, int):<> bool = "mac#%"
fun
eq_int_double
  (int, double):<> bool = "mac#%"
fun
eq_double_int
  (double, int):<> bool = "mac#%"
//
overload = with eq_int_float of 0
overload = with eq_float_int of 0
overload = with eq_int_double of 0
overload = with eq_double_int of 0
//
fun
neq_int_float
  (int, float):<> bool = "mac#%"
fun
neq_float_int
  (float, int):<> bool = "mac#%"
fun
neq_int_double
  (int, double):<> bool = "mac#%"
fun
neq_double_int
  (double, int):<> bool = "mac#%"
//
overload != with neq_int_float of 0
overload <> with neq_int_float of 0
overload != with neq_float_int of 0
overload <> with neq_float_int of 0
//
overload != with neq_int_double of 0
overload <> with neq_int_double of 0
overload != with neq_double_int of 0
overload <> with neq_double_int of 0
//
(* ****** ****** *)
//
fun
{tk:tk}
g0float_npow
  (x: g0float(tk), n: intGte(0)):<> g0float(tk)
//
overload ** with g0float_npow of 0
//
(* ****** ****** *)

macdef g0i2f (x) = g0int2float (,(x))
macdef g0f2i (x) = g0float2int (,(x))
macdef g0f2f (x) = g0float2float (,(x))

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

(* end of [float.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/string.atxt
** Time of generation: Fri Aug 18 03:29:50 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: September, 2011 *)

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

(*
** HX: a string is a null-terminated arrayref of characters
*)

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

sortdef tk = tkind

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

typedef SHR(a:type) = a // for commenting purpose
typedef NSH(a:type) = a // for commenting purpose

(* ****** ****** *)
//
typedef
stringLt(n:int) = [k:nat | k < n] string(k)
typedef
stringLte(n:int) = [k:nat | k <= n] string(k)
//
typedef
stringGt(n:int) = [k:int | k > n] string(k)
typedef
stringGte(n:int) = [k:int | k >= n] string(k)
//
typedef
stringBtw
  (m:int, n:int) = [k:int | m <= k; k < n] string(k)
typedef
stringBtwe
  (m:int, n:int) = [k:int | m <= k; k <= n] string(k)
//
(* ****** ****** *)
//
typedef stringlst = List0(string)
vtypedef stringlst_vt = List0_vt(string)
//
(* ****** ****** *)
//
typedef stringopt = Option(string)
//
(* ****** ****** *)

dataprop
string_index_p
(
  n: int, int(*i*), int(*c*)
) =
  | string_index_p_eqz(n, n, 0)
  | {i:int | n > i}
    {c:int8 | c != 0}
    string_index_p_neqz(n, i, c)
// end of [string_index_p]

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

exception StringSubscriptExn of ((*void*))

(* ****** ****** *)
//
praxi
lemma_string_param{n:int}(string n): [n >= 0] void
//
(* ****** ****** *)

castfn
string2ptr (x: string):<> Ptr1
overload ptrcast with string2ptr

(* ****** ****** *)
//
// HX:
// [string2string] = [string1_of_string0]
//
castfn g0ofg1_string (x: String):<> string
castfn g1ofg0_string (x: string):<> String0
//
overload g0ofg1 with g0ofg1_string // index-erasing
overload g1ofg0 with g1ofg0_string // index-inducing
//
(* ****** ****** *)

fun{}
string_char (str: string):<> char

(* ****** ****** *)
//
fun{}
string_nil((*void*)):<!wrt> strnptr(0)
fun{}
string_sing(chr: charNZ):<!wrt> strnptr(1)
//
(* ****** ****** *)
//
fun{}
string_is_empty
  {n:int}(str: string(n)):<> bool(n==0)
fun{}
string_isnot_empty
  {n:int}(str: string(n)):<> bool(n > 0)
//
(* ****** ****** *)
//
fun{}
string_is_atend_size
  {n:int}{i:nat | i <= n}
  (s: string(n), i: size_t(i)):<> bool(i==n)
fun{tk:tk}
string_is_atend_gint
  {n:int}{i:nat | i <= n}
  (s: string(n), i: g1int(tk, i)):<> bool(i==n)
fun{tk:tk}
string_is_atend_guint
  {n:int}{i:nat | i <= n}
  (s: string(n), i: g1uint(tk, i)):<> bool(i==n)
//
symintr string_is_atend
overload string_is_atend with string_is_atend_gint
overload string_is_atend with string_is_atend_guint
//
(* ****** ****** *)

macdef
string_isnot_atend
  (string, index) = ~string_is_atend (,(string), ,(index))
// end of [string_isnot_atend]

(* ****** ****** *)
//
fun{}
string_head{n:pos} (str: string(n)):<> charNZ
fun{}
string_tail{n:pos} (str: string(n)):<> string(n-1)
//
(* ****** ****** *)

fun{}
string_get_at_size
  {n:int}{i:nat | i < n}
  (s: string(n), i: size_t(i)):<> charNZ
fun{tk:tk}
string_get_at_gint
  {n:int}{i:nat | i < n}
  (s: string(n), i: g1int(tk, i)):<> charNZ
fun{tk:tk}
string_get_at_guint
  {n:int}{i:nat | i < n}
  (s: string(n), i: g1uint(tk, i)):<> charNZ
//
symintr string_get_at
overload string_get_at with string_get_at_size of 1
overload string_get_at with string_get_at_gint of 0
overload string_get_at with string_get_at_guint of 0
//
(* ****** ****** *)

fun{}
string_test_at_size
  {n:int}{i:nat | i <= n}
  (s: string(n), i: size_t(i)):<> [c:int] (string_index_p(n, i, c) | char(c))
fun{tk:tk}
string_test_at_gint
  {n:int}{i:nat | i <= n}
  (s: string(n), i: g1int(tk, i)):<> [c:int] (string_index_p(n, i, c) | char(c))
fun{tk:tk}
string_test_at_guint
  {n:int}{i:nat | i <= n}
  (s: string(n), i: g1uint(tk, i)):<> [c:int] (string_index_p(n, i, c) | char(c))
//
symintr string_test_at
overload string_test_at with string_test_at_size of 1
overload string_test_at with string_test_at_gint of 0
overload string_test_at with string_test_at_guint of 0
//
(* ****** ****** *)

fun lt_string_string
  (x1: string, x2: string):<> bool = "mac#%"
overload < with lt_string_string
fun lte_string_string
  (x1: string, x2: string):<> bool = "mac#%"
overload <= with lte_string_string

fun gt_string_string
  (x1: string, x2: string):<> bool = "mac#%"
overload > with gt_string_string
fun gte_string_string
  (x1: string, x2: string):<> bool = "mac#%"
overload >= with gte_string_string

fun eq_string_string
  (x1: string, x2: string):<> bool = "mac#%"
overload = with eq_string_string
fun neq_string_string
  (x1: string, x2: string):<> bool = "mac#%"
overload != with neq_string_string
overload <> with neq_string_string

fun compare_string_string
  (x1: string, x2: string):<> Sgn = "mac#%"
overload compare with compare_string_string

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

fun{
} strcmp (x1: string, x2: string):<> int

fun{
} strintcmp
  {n1,n2:int | n2 >=0}
  (x1: string n1, n2: int n2):<> int(sgn(n1-n2))
// end of [strintcmp]

fun{
} strlencmp
  {n1,n2:int}
  (x1: string n1, x2: string n2):<> int(sgn(n1-n2))
// end of [strlencmp]

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

fun{}
string_make_list
  {n:int}
  (cs: list(charNZ, n)):<!wrt> strnptr(n)
fun{}
string_make_listlen
  {n:int}
  (cs: list(charNZ, n), n: int(n)):<!wrt> strnptr(n)

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

fun{}
string_make_rlist
  {n:int}
  (cs: list(charNZ, n)):<!wrt> strnptr(n)
// end of [string_make_rlist]

fun{}
string_make_rlistlen
  {n:int}
  (cs: list(charNZ, n), n: int(n)):<!wrt> strnptr(n)
// end of [string_make_rlistlen]

(* ****** ****** *)
//
fun{}
string_make_list_vt
  {n:int}
  (cs: list_vt(charNZ, n)):<!wrt> strnptr(n)
//
fun{}
string_make_listlen_vt
  {n:int}
  (cs: list_vt(charNZ, n), n: int(n)):<!wrt> strnptr(n)
//
(* ****** ****** *)
//
fun{}
string_make_rlist_vt
  {n:int}
  (cs: list_vt(charNZ, n)):<!wrt> strnptr(n)
//
fun{}
string_make_rlistlen_vt
  {n:int}
  (cs: list_vt(charNZ, n), n: int(n)):<!wrt> strnptr(n)
//
(* ****** ****** *)
//
fun{}
string_make_stream
  {n:int}(cs: stream(charNZ)):<!wrt> Strptr1
fun{}
string_make_stream_vt
  {n:int}(cs: stream_vt(charNZ)):<!wrt> Strptr1
//
fun{}
string_make_stream$bufsize
   ((*void*)):<> intGte(1) // HX: the default = 16
//
(* ****** ****** *)

fun{}
string_make_substring
  {n:int}{st,ln:nat | st+ln <= n}
  (str: string(n), st: size_t st, ln: size_t ln):<!wrt> strnptr(ln)
// end of [string_make_substring]

(* ****** ****** *)
//
fun
print_string(x: string): void = "mac#%"
fun
prerr_string(x: string): void = "mac#%"
fun
fprint_string(out: FILEref, x: string): void = "mac#%"
//
(* ****** ****** *)
//
fun
fprint_substring
  {n:int}{st,ln:nat | st+ln <= n}
(
  out: FILEref, str: string(n), st: size_t(st), ln: size_t(ln)
) : void = "mac#%" // end of [fprint_substring]
//
(* ****** ****** *)

fun{}
strchr{n:int}
  (str: string(n), c0: char):<> ssizeBtwe(~1, n)
// end of [strchr]

fun{}
strrchr{n:int}
  (str: string(n), c0: char):<> ssizeBtwe(~1, n)
// end of [strrchr]

fun{}
strstr{n:int}
  (haystack: string(n), needle: string):<> ssizeBtw(~1, n)
// end of [strstr]

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

fun{}
strspn{n:int} // spanning
  (str: string(n), accept: string):<> sizeLte(n)
// end of [strspn]
fun{}
strcspn{n:int} // complement spanning
  (str: string(n), accept: string):<> sizeLte(n)
// end of [strcspn]

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

fun{}
string_index{n:int}
  (str: string(n), c0: charNZ):<> ssizeBtw(~1, n)
// end of [string_index]

fun{}
string_rindex{n:int}
  (str: string(n), c0: charNZ):<> ssizeBtw(~1, n)
// end of [string_rindex]

(* ****** ****** *)
//
fun{}
string0_length
  (x: NSH(string)):<> size_t
fun{}
string1_length
  {n:int} (x: NSH(string(n))):<> size_t(n)
//
symintr strlen
symintr string_length
overload strlen with string0_length of 0
overload strlen with string1_length of 10
overload string_length with string0_length of 0
overload string_length with string1_length of 10
//
(* ****** ****** *)
//
fun{}
string0_nlength
  (x: NSH(string), n: size_t):<> size_t
fun{}
string1_nlength
  {n1,n2:int}
  (NSH(string(n1)), size_t(n2)):<> size_t(min(n1,n2))
//
symintr string_nlength
overload string_nlength with string0_nlength of 0
overload string_nlength with string1_nlength of 10
//
(* ****** ****** *)
//
fun{}
string0_copy
  (cs: NSH(string)):<!wrt> Strptr1
fun{}
string1_copy
  {n:int}
  (cs: NSH(string(n))):<!wrt> strnptr(n)
//
(* ****** ****** *)
//
// HX-2016-11-13:
// This can be done by calling
// [string_copy] and then [strptr_set_at]
//
fun{}
string_fset_at_size
  {n:int}{i:nat | i < n}
  (NSH(string(n)), i: size_t(i), c: charNZ):<!wrt> string(n)
//
(*
fun{tk:tk}
string_fset_at_gint
  {n:int}{i:nat | i < n}
  (NSH(string(n)), i: g1int(tk, i), c: charNZ):<!wrt> string(n)
fun{tk:tk}
string_fset_at_guint
  {n:int}{i:nat | i < n}
  (NSH(string(n)), i: g1uint(tk, i), c: charNZ):<!wrt> string(n)
*)
//
symintr string_fset_at
overload string_fset_at with string_fset_at_size of 1
//
(* ****** ****** *)
//
fun{}
string0_append
(
  x1: NSH(string), x2: NSH(string)
) :<!wrt> Strptr1 // end-of-function
fun{}
string1_append
  {n1,n2:int} (
  x1: NSH(string(n1)), x2: NSH(string(n2))
) :<!wrt> strnptr(n1+n2) // end of [string1_append]
//
symintr string_append
overload string_append with string0_append of 0
(*
//
// HX: too much of a surprise!
//
overload string_append with string1_append of 20
*)
//
(* ****** ****** *)
//
fun{}
string0_append3
(
  x1: NSH(string)
, x2: NSH(string), x3: NSH(string)
) :<!wrt> Strptr1 // end-of-function
fun{}
string0_append4
(
  x1: NSH(string), x2: NSH(string)
, x3: NSH(string), x4: NSH(string)
) :<!wrt> Strptr1 // end-of-function
fun{}
string0_append5
(
  x1: NSH(string), x2: NSH(string)
, x3: NSH(string), x4: NSH(string), x5: NSH(string)
) :<!wrt> Strptr1 // end-of-function
fun{}
string0_append6
(
  x1: NSH(string), x2: NSH(string), x3: NSH(string)
, x4: NSH(string), x5: NSH(string), x6: NSH(string)
) :<!wrt> Strptr1 // end-of-function
//
overload string_append with string0_append3 of 0
overload string_append with string0_append4 of 0
overload string_append with string0_append5 of 0
overload string_append with string0_append6 of 0
//
(* ****** ****** *)
//
fun{}
stringarr_concat{n:int}
(
xs: arrayref(string, n), n: size_t(n)
) :<!wrt> Strptr1 // end of [stringarr]
//
fun{}
stringlst_concat(List(string)):<!wrt> Strptr1
//
(* ****** ****** *)
//
fun{}
string_implode
  {n:int}
  (cs: list(charNZ, n)):<!wrt> strnptr(n)
//
fun{}
string_explode
  {n:int} (x: string(n)):<!wrt> list_vt(charNZ, n)
//
(* ****** ****** *)
//
fun{}
string_tabulate$fopr(size_t): charNZ
fun{}
string_tabulate{n:int}(n: size_t(n)): strnptr(n)
//
fun{}
string_tabulate_cloref{n:int}
  (n: size_t(n), f: (sizeLt(n)) -<cloref1> charNZ): strnptr(n)
//
(* ****** ****** *)
//
fun{}
string_forall(str: string): bool
fun{}
string_forall$pred(c: char): bool
//
fun{}
string_iforall(str: string): bool
fun{}
string_iforall$pred(i: int, c: char): bool
//
(* ****** ****** *)
//
fun{env:vt0p}
string_foreach$cont(c: char, env: &env): bool
fun{env:vt0p}
string_foreach$fwork(c: char, env: &(env) >> _): void
//
fun{
} string_foreach {n:int} (str: string(n)): sizeLte(n)
fun{
env:vt0p
} string_foreach_env
  {n:int} (str: string(n), env: &(env) >> _): sizeLte(n)
// end of [string_foreach_env]
//
(* ****** ****** *)
//
fun{env:vt0p}
string_rforeach$cont(c: char, env: &env): bool
fun{env:vt0p}
string_rforeach$fwork(c: char, env: &(env) >> _): void
//
fun{}
string_rforeach{n:int}(str: string(n)): sizeLte(n)
fun{
env:vt0p
} string_rforeach_env
  {n:int}(str: string(n), env: &(env) >> _): sizeLte(n)
// end of [string_rforeach_env]
//
(* ****** ****** *)
//
fun{}
streamize_string_char(string): stream_vt(charNZ)
//
(* ****** ****** *)
//
(*
** HX:
** [stropt_none] is just the null pointer
*)
fun stropt_none((*void*)): stropt(~1) = "mac#%"
//
(* ****** ****** *)
//
castfn stropt0_some(x: SHR(string)): Stropt1
castfn stropt1_some{n:int}(x: SHR(string(n))): stropt(n)
//
symintr stropt_some
overload stropt_some with stropt0_some of 0
overload stropt_some with stropt1_some of 10
//
(* ****** ****** *)

fun{}
stropt_is_none{n:int}(stropt(n)):<> bool(n < 0)
fun{}
stropt_is_some{n:int}(stropt(n)):<> bool(n >= 0)

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

castfn
stropt_unsome{n:nat}(opt: stropt(n)):<> string(n)

(* ****** ****** *)
//
fun{}
stropt_length{n:int}(opt: stropt(n)):<> ssize_t(n)
//
(* ****** ****** *)
//
fun
print_stropt(opt: Stropt0): void = "mac#%"
fun
prerr_stropt(opt: Stropt0): void = "mac#%"
fun
fprint_stropt(out: FILEref, opt: Stropt0): void = "mac#%"
//
(* ****** ****** *)
//
// overloading for certain symbols
//
overload
[] with string_get_at_size of 1
overload
[] with string_get_at_gint of 0
overload
[] with string_get_at_guint of 0
//
overload
iseqz with string_is_empty of 10
overload
isneqz with string_isnot_empty of 10
//
overload length with string_length
//
(* ****** ****** *)
//
overload .head with string_head of 10
overload .tail with string_tail of 10
//
(* ****** ****** *)
//
overload copy with string0_copy of 0
//
(*
//
// HX: too much of a surprise!
//
overload copy with string1_copy of 10
*)
//
overload print with print_string of 0
overload prerr with prerr_string of 0
overload fprint with fprint_string of 0
//
(* ****** ****** *)
//
overload unsome with stropt_unsome
//
overload iseqz with stropt_is_none
overload isneqz with stropt_is_some
//
overload length with stropt_length of 0
//
overload print with print_stropt of 0
overload prerr with prerr_stropt of 0
overload fprint with fprint_stropt of 0
//
(* ****** ****** *)

(* end of [string.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/strptr.atxt
** Time of generation: Fri Aug 18 03:29:50 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: February, 2012 *)

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

(*
** HX-2012:
** a Strptr0 is either the null-pointer or Strptr1
** a Strptr1 is a null-terminated arrayptr of characters
*)

(* ****** ****** *)
//
abst@ype
strbuf_t0ype
  (m:int, n:int) // HX: [m] byte size
//
(* ****** ****** *)
//
stadef
strbuf = strbuf_t0ype
viewdef
strbuf_v
  (l:addr, m:int, n:int) = strbuf (m, n) @ l
//
(* ****** ****** *)
//
praxi
strbuf2bytes
  {m,n:int}
  (buf: &strbuf (m, n) >> b0ytes (m)): void
//
praxi
strbuf2bytes_v
  {l:addr}{m,n:int}
  (pf: strbuf_v (l, m, n)): b0ytes_v (l, m)
//
(* ****** ****** *)

praxi
lemma_strptr_param
  {l:addr} (x: !strptr l): [l>=null] void
// end of [lemma_strptr_param]

praxi
lemma_strnptr_param
  {l:addr}{n:int}
(
  x: !strnptr (l, n)
) : [(l>null&&n>=0) || (l==null&&n==(~1))] void
// end of [lemma_strnptr_param]

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

praxi
lemma_strbuf_param
  {l:addr}{m,n:int}
  (x: &strbuf (m, n)): [m>n] void
// end of [lemma_strbuf_param]

praxi
lemma_strbuf_v_param
  {l:addr}{m,n:int}
  (pf: !strbuf_v (l, m, n)): [l>null;m>n] void
// end of [lemma_strbuf_v_param]

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

castfn
strptr2ptr
  {l:addr}(x: !strptr l):<> ptr (l)
castfn
strnptr2ptr
  {l:addr}{n:int}(x: !strnptr(l, n)):<> ptr(l)
// end of [strnptr2ptr]

(* ****** ****** *)
//
castfn
strnptr2strptr
  {l:addr}{n:int}(x: strnptr(l, n)):<> strptr(l)
// end of [strnptr2strptr]

castfn
strptr2strnptr
  {l:addr}(x: strptr(l)):<> [n:int] strnptr(l, n)
// end of [strptr2strnptr]
//
(* ****** ****** *)
//
castfn
strptr2stropt
  {l:addr}
(
  x: strptr (l)
) :<>
[n:int
|(l==null&&n < 0)||(l>null&&n>=0)
] stropt(n)
//
castfn
strptr2stropt0(x: Strptr0):<> Stropt0
castfn
stropt2stropt1(x: Strptr1):<> Stropt1
//
castfn
strnptr2stropt
  {l:addr}{n:int}
  (x: strnptr(l, n)):<> stropt(n)
//
(* ****** ****** *)
//
castfn
strptr2string(x: Strptr1):<> String
//
castfn
strnptr2string
  {l:addr}{n:nat}(x: strnptr(l, n)):<> string(n)
//
(* ****** ****** *)

fun strptr_null():<> strptr(null) = "mac#%"

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

praxi
strptr_free_null
  {l:addr | l <= null} (x: strptr(l)):<> void
// end of [strptr_free_null]

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

fun{}
strptr_is_null
  {l:addr} (x: !strptr(l)):<> bool(l==null)
fun{}
strptr_isnot_null
  {l:addr} (x: !strptr(l)):<> bool(l > null)

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

fun{}
strptr_is_empty(x: !Strptr1):<> bool
fun{}
strptr_isnot_empty(x: !Strptr1):<> bool

(* ****** ****** *)
//
fun{}
strnptr_is_null
  {l:addr}{n:int}
  (x: !strnptr(l, n)):<> bool(l==null)
fun{}
strnptr_isnot_null
  {l:addr}{n:int}
  (x: !strnptr(l, n)):<> bool(l > null)
//
(* ****** ****** *)
//
praxi
strnptr_free_null
  {l:addr|l <= null}{n:int}(x: strnptr(l, n)):<> void
// end of [strnptr_free_null]
//
(* ****** ****** *)

fun lt_strptr_strptr
  (x1: !Strptr0, x2: !Strptr0):<> bool = "mac#%"
overload < with lt_strptr_strptr
fun lte_strptr_strptr
  (x1: !Strptr0, x2: !Strptr0):<> bool = "mac#%"
overload <= with lte_strptr_strptr

fun gt_strptr_strptr
  (x1: !Strptr0, x2: !Strptr0):<> bool = "mac#%"
overload > with gt_strptr_strptr
fun gte_strptr_strptr
  (x1: !Strptr0, x2: !Strptr0):<> bool = "mac#%"
overload >= with gte_strptr_strptr

fun eq_strptr_strptr
  (x1: !Strptr0, x2: !Strptr0):<> bool = "mac#%"
overload = with eq_strptr_strptr
fun neq_strptr_strptr
  (x1: !Strptr0, x2: !Strptr0):<> bool = "mac#%"
overload != with neq_strptr_strptr
overload <> with neq_strptr_strptr

(* ****** ****** *)
//
fun compare_strptr_strptr
  (x1: !Strptr0, x2: !Strptr0):<> Sgn = "mac#%"
//
(* ****** ****** *)

fun eq_strptr_string
  (x1: !Strptr1, x2: string):<> bool = "mac#%"
overload = with eq_strptr_string

fun neq_strptr_string
  (x1: !Strptr1, x2: string):<> bool = "mac#%"
overload != with neq_strptr_string
overload <> with neq_strptr_string

(* ****** ****** *)
//
fun compare_strptr_string
  (x1: !Strptr1, x2: string):<> Sgn = "mac#%"
//
(* ****** ****** *)

fun strptr_free (x: Strptr0):<!wrt> void = "mac#%"
fun strnptr_free (x: Strnptr0):<!wrt> void = "mac#%"

(* ****** ****** *)
//
fun
fprint_strptr
(
  out: FILEref, x: !Strptr0
) : void = "mac#%"
//
fun print_strptr (x: !Strptr0): void = "mac#%"
fun prerr_strptr (x: !Strptr0): void = "mac#%"
//
(* ****** ****** *)
//
fun
print_strbuf
  {m,n:int}(buf: &strbuf(m, n)): void = "mac#%"
fun
prerr_strbuf
  {m,n:int}(buf: &strbuf(m, n)): void = "mac#%"
//
fun
fprint_strbuf{m,n:int}
  (out: FILEref, buf: &strbuf (m, n)): void = "mac#%"
//
(* ****** ****** *)
//
fun{}
strnptr_get_at_size
  {n:int}
  (str: !strnptr (n), i: sizeLt n):<> charNZ
//
fun{tk:tk}
strnptr_get_at_gint
  {n:int}{i:nat | i < n}
  (str: !strnptr(n), i: g1int(tk, i)):<> charNZ
fun{tk:tk}
strnptr_get_at_guint
  {n:int}{i:nat | i < n}
  (str: !strnptr(n), i: g1uint(tk, i)):<> charNZ
//
symintr strnptr_get_at
overload strnptr_get_at with strnptr_get_at_size of 1
overload strnptr_get_at with strnptr_get_at_gint of 0
overload strnptr_get_at with strnptr_get_at_guint of 0
//
(* ****** ****** *)
//
fun{}
strnptr_set_at_size
  {n:int}
  (str: !strnptr(n), i: sizeLt n, c: charNZ):<!wrt> void
//
fun{tk:tk}
strnptr_set_at_gint
  {n:int}{i:nat | i < n}
  (str: !strnptr(n), i: g1int(tk, i), c: charNZ):<!wrt> void
fun{tk:tk}
strnptr_set_at_guint
  {n:int}{i:nat | i < n}
  (str: !strnptr(n), i: g1uint(tk, i), c: charNZ):<!wrt> void
//
symintr strnptr_set_at
overload strnptr_set_at with strnptr_set_at_size of 1
overload strnptr_set_at with strnptr_set_at_gint of 0
overload strnptr_set_at with strnptr_set_at_guint of 0
//
(* ****** ****** *)

fun{}
strptr_length (x: !Strptr0):<> ssize_t
fun{}
strnptr_length {n:int} (x: !strnptr n):<> ssize_t (n)

(* ****** ****** *)
//
fun{}
strptr0_copy (x: !Strptr0):<!wrt> Strptr0
fun{}
strptr1_copy (x: !Strptr1):<!wrt> Strptr1
fun{}
strnptr_copy
  {n:int} (x: !strnptr (n)):<!wrt> strnptr (n)
//
(* ****** ****** *)
//
fun{}
strptr_append
  (x1: !Strptr0, x2: !Strptr0):<!wrt> Strptr0
fun{}
strnptr_append{n1,n2:nat}
  (x1: !strnptr n1, x2: !strnptr n2):<!wrt> strnptr(n1+n2)
//
(* ****** ****** *)

fun{}
strptrlst_free (xs: List_vt(Strptr0)):<!wrt> void

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

fun{}
strptrlst_concat (xs: List_vt(Strptr0)):<!wrt> Strptr0

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

fun{
env:vt0p
} strnptr_foreach$cont (c: &charNZ, env: &env): bool
fun{
env:vt0p
} strnptr_foreach$fwork (c: &charNZ >> _, env: &env): void
fun{}
strnptr_foreach {n:nat} (str: !strnptr n): sizeLte(n)
fun{
env:vt0p
} strnptr_foreach_env
  {n:nat} (str: !strnptr n, env: &(env) >> _): sizeLte(n)
// end of [strnptr_foreach_env]

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

fun{
env:vt0p
} strnptr_rforeach$cont (c: &charNZ, env: &env): bool
fun{
env:vt0p
} strnptr_rforeach$fwork (c: &charNZ >> _, env: &env): void
fun{}
strnptr_rforeach {n:nat} (str: !strnptr n): sizeLte(n)
fun{
env:vt0p
} strnptr_rforeach_env
  {n:nat} (str: !strnptr n, env: &(env) >> _): sizeLte(n)
// end of [strnptr_rforeach_env]

(* ****** ****** *)
//
// overloading for certain symbols
//
overload
[] with strnptr_get_at_size of 1
overload
[] with strnptr_get_at_gint of 0
overload
[] with strnptr_get_at_guint of 0
//
overload
[] with strnptr_set_at_size of 1
overload
[] with strnptr_set_at_gint of 0
overload
[] with strnptr_set_at_guint of 0
//
overload iseqz with strptr_is_null
overload iseqz with strnptr_is_null
overload isneqz with strptr_isnot_null
overload isneqz with strnptr_isnot_null
//
overload
compare with compare_strptr_strptr
overload
compare with compare_strptr_string
//
overload length with strptr_length
overload length with strnptr_length
//
overload copy with strptr0_copy of 0
overload copy with strptr1_copy of 10
//
overload free with strptr_free
overload free with strnptr_free
//
overload print with print_strptr
overload prerr with prerr_strptr
overload fprint with fprint_strptr
//
overload print with print_strbuf
overload prerr with prerr_strbuf
overload fprint with fprint_strbuf
//
overload ptrcast with strptr2ptr
overload ptrcast with strnptr2ptr
//
(* ****** ****** *)

(* end of [strptr.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: gmhwxiATgmailDOTcom *)
(* Start time: January, 2013 *)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/integer_ptr.atxt
** Time of generation: Fri Aug 18 03:29:50 2017
*)

(* ****** ****** *)
//
// HX: for unindexed integer types
//
(* ****** ****** *)

sortdef tk = tkind

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

typedef SHR(a:t@ype) = a // for commenting purpose
typedef NSH(a:t@ype) = a // for commenting purpose

(* ****** ****** *)
//
stadef intptrknd = intptr_kind
stadef uintptrknd = uintptr_kind
//
(* ****** ****** *)
//
fun g0int2int_int_intptr(int):<> intptr = "mac#%"
fun g1int2int_int_intptr{i:int}(int(i)):<> intptr(i) = "mac#%"
fun g0int2int_lint_intptr(lint):<> intptr = "mac#%"
fun g1int2int_lint_intptr{i:int}(lint(i)):<> intptr(i) = "mac#%"
//
(* ****** ****** *)
//
fun g0int2uint_int_uintptr(int):<> uintptr = "mac#%"
fun g1int2uint_int_uintptr{i:nat}(int(i)):<> uintptr(i) = "mac#%"
//
(* ****** ****** *)
//
fun g0uint2uint_uint_uintptr(uint):<> uintptr = "mac#%"
fun g1uint2uint_uint_uintptr{u:int}(uint(u)):<> uintptr(u) = "mac#%"
fun g0uint2uint_ulint_uintptr(ulint):<> uintptr = "mac#%"
fun g1uint2uint_ulint_uintptr{u:int}(ulint(u)):<> uintptr(u) = "mac#%"
//
(* ****** ****** *)
//
fun g0int_neg_intptr (x: intptr):<> intptr = "mac#%"
fun g0int_abs_intptr (x: intptr):<> intptr = "mac#%"
fun g0int_succ_intptr (x: intptr):<> intptr = "mac#%"
fun g0int_pred_intptr (x: intptr):<> intptr = "mac#%"
fun g0int_half_intptr (x: intptr):<> intptr = "mac#%"
fun g0int_asl_intptr (x: intptr, n: intGte(0)):<> intptr = "mac#%"
fun g0int_asr_intptr (x: intptr, n: intGte(0)):<> intptr = "mac#%"
fun g0int_add_intptr (x: intptr, y: intptr):<> intptr = "mac#%"
fun g0int_sub_intptr (x: intptr, y: intptr):<> intptr = "mac#%"
fun g0int_mul_intptr (x: intptr, y: intptr):<> intptr = "mac#%"
fun g0int_div_intptr (x: intptr, y: intptr):<> intptr = "mac#%"
fun g0int_mod_intptr (x: intptr, y: intptr):<> intptr = "mac#%"
fun g0int_lt_intptr (x: intptr, y: intptr):<> bool = "mac#%"
fun g0int_lte_intptr (x: intptr, y: intptr):<> bool = "mac#%"
fun g0int_gt_intptr (x: intptr, y: intptr):<> bool = "mac#%"
fun g0int_gte_intptr (x: intptr, y: intptr):<> bool = "mac#%"
fun g0int_eq_intptr (x: intptr, y: intptr):<> bool = "mac#%"
fun g0int_neq_intptr (x: intptr, y: intptr):<> bool = "mac#%"
fun g0int_compare_intptr (x: intptr, y: intptr):<> int = "mac#%"
fun g0int_max_intptr (x: intptr, y: intptr):<> intptr = "mac#%"
fun g0int_min_intptr (x: intptr, y: intptr):<> intptr = "mac#%"
fun g0int_isltz_intptr (x: intptr):<> bool = "mac#%"
fun g0int_isltez_intptr (x: intptr):<> bool = "mac#%"
fun g0int_isgtz_intptr (x: intptr):<> bool = "mac#%"
fun g0int_isgtez_intptr (x: intptr):<> bool = "mac#%"
fun g0int_iseqz_intptr (x: intptr):<> bool = "mac#%"
fun g0int_isneqz_intptr (x: intptr):<> bool = "mac#%"
//
(* ****** ****** *)
//
fun print_intptr (intptr): void = "mac#%"
fun prerr_intptr (intptr): void = "mac#%"
fun fprint_intptr : fprint_type (intptr) = "mac#%"
overload print with print_intptr
overload prerr with prerr_intptr
overload fprint with fprint_intptr
//
(* ****** ****** *)
//
fun g0uint_succ_uintptr (x: uintptr):<> uintptr = "mac#%"
fun g0uint_pred_uintptr (x: uintptr):<> uintptr = "mac#%"
fun g0uint_half_uintptr (x: uintptr):<> uintptr = "mac#%"
fun g0uint_add_uintptr (x: uintptr, y: uintptr):<> uintptr = "mac#%"
fun g0uint_sub_uintptr (x: uintptr, y: uintptr):<> uintptr = "mac#%"
fun g0uint_mul_uintptr (x: uintptr, y: uintptr):<> uintptr = "mac#%"
fun g0uint_div_uintptr (x: uintptr, y: uintptr):<> uintptr = "mac#%"
fun g0uint_mod_uintptr (x: uintptr, y: uintptr):<> uintptr = "mac#%"
fun g0uint_lsl_uintptr (x: uintptr, n: intGte(0)):<> uintptr = "mac#%"
fun g0uint_lsr_uintptr (x: uintptr, n: intGte(0)):<> uintptr = "mac#%"
fun g0uint_lnot_uintptr (x: uintptr):<> uintptr = "mac#%"
fun g0uint_lor_uintptr (x: uintptr, y: uintptr):<> uintptr = "mac#%"
fun g0uint_lxor_uintptr (x: uintptr, y: uintptr):<> uintptr = "mac#%"
fun g0uint_land_uintptr (x: uintptr, y: uintptr):<> uintptr = "mac#%"
fun g0uint_lt_uintptr (x: uintptr, y: uintptr):<> bool = "mac#%"
fun g0uint_lte_uintptr (x: uintptr, y: uintptr):<> bool = "mac#%"
fun g0uint_gt_uintptr (x: uintptr, y: uintptr):<> bool = "mac#%"
fun g0uint_gte_uintptr (x: uintptr, y: uintptr):<> bool = "mac#%"
fun g0uint_eq_uintptr (x: uintptr, y: uintptr):<> bool = "mac#%"
fun g0uint_neq_uintptr (x: uintptr, y: uintptr):<> bool = "mac#%"
fun g0uint_compare_uintptr (x: uintptr, y: uintptr):<> int = "mac#%"
fun g0uint_max_uintptr (x: uintptr, y: uintptr):<> uintptr = "mac#%"
fun g0uint_min_uintptr (x: uintptr, y: uintptr):<> uintptr = "mac#%"
fun g0uint_isgtz_uintptr (x: uintptr):<> bool = "mac#%"
fun g0uint_iseqz_uintptr (x: uintptr):<> bool = "mac#%"
fun g0uint_isneqz_uintptr (x: uintptr):<> bool = "mac#%"
//
(* ****** ****** *)
//
fun print_uintptr (uintptr): void = "mac#%"
fun prerr_uintptr (uintptr): void = "mac#%"
fun fprint_uintptr : fprint_type (uintptr) = "mac#%"
overload print with print_uintptr
overload prerr with prerr_uintptr
overload fprint with fprint_uintptr
//
(* ****** ****** *)
//
fun g1int_neg_intptr : g1int_neg_type (intptrknd) = "mac#%"
fun g1int_abs_intptr : g1int_abs_type (intptrknd) = "mac#%"
fun g1int_succ_intptr : g1int_succ_type (intptrknd) = "mac#%"
fun g1int_pred_intptr : g1int_pred_type (intptrknd) = "mac#%"
fun g1int_half_intptr : g1int_half_type (intptrknd) = "mac#%"
fun g1int_add_intptr : g1int_add_type (intptrknd) = "mac#%"
fun g1int_sub_intptr : g1int_sub_type (intptrknd) = "mac#%"
fun g1int_mul_intptr : g1int_mul_type (intptrknd) = "mac#%"
fun g1int_div_intptr : g1int_div_type (intptrknd) = "mac#%"
fun g1int_nmod_intptr : g1int_nmod_type (intptrknd) = "mac#%"
fun g1int_lt_intptr : g1int_lt_type (intptrknd) = "mac#%"
fun g1int_lte_intptr : g1int_lte_type (intptrknd) = "mac#%"
fun g1int_gt_intptr : g1int_gt_type (intptrknd) = "mac#%"
fun g1int_gte_intptr : g1int_gte_type (intptrknd) = "mac#%"
fun g1int_eq_intptr : g1int_eq_type (intptrknd) = "mac#%"
fun g1int_neq_intptr : g1int_neq_type (intptrknd) = "mac#%"
fun g1int_compare_intptr : g1int_compare_type (intptrknd) = "mac#%"
fun g1int_max_intptr : g1int_max_type (intptrknd) = "mac#%"
fun g1int_min_intptr : g1int_min_type (intptrknd) = "mac#%"
fun g1int_isltz_intptr : g1int_isltz_type (intptrknd) = "mac#%"
fun g1int_isltez_intptr : g1int_isltez_type (intptrknd) = "mac#%"
fun g1int_isgtz_intptr : g1int_isgtz_type (intptrknd) = "mac#%"
fun g1int_isgtez_intptr : g1int_isgtez_type (intptrknd) = "mac#%"
fun g1int_iseqz_intptr : g1int_iseqz_type (intptrknd) = "mac#%"
fun g1int_isneqz_intptr : g1int_isneqz_type (intptrknd) = "mac#%"
//
(* ****** ****** *)
//
fun g1uint_succ_uintptr : g1uint_succ_type (uintptrknd) = "mac#%"
fun g1uint_pred_uintptr : g1uint_pred_type (uintptrknd) = "mac#%"
fun g1uint_half_uintptr : g1uint_half_type (uintptrknd) = "mac#%"
fun g1uint_add_uintptr : g1uint_add_type (uintptrknd) = "mac#%"
fun g1uint_sub_uintptr : g1uint_sub_type (uintptrknd) = "mac#%"
fun g1uint_mul_uintptr : g1uint_mul_type (uintptrknd) = "mac#%"
fun g1uint_div_uintptr : g1uint_div_type (uintptrknd) = "mac#%"
fun g1uint_mod_uintptr : g1uint_mod_type (uintptrknd) = "mac#%"
fun g1uint_lt_uintptr : g1uint_lt_type (uintptrknd) = "mac#%"
fun g1uint_lte_uintptr : g1uint_lte_type (uintptrknd) = "mac#%"
fun g1uint_gt_uintptr : g1uint_gt_type (uintptrknd) = "mac#%"
fun g1uint_gte_uintptr : g1uint_gte_type (uintptrknd) = "mac#%"
fun g1uint_eq_uintptr : g1uint_eq_type (uintptrknd) = "mac#%"
fun g1uint_neq_uintptr : g1uint_neq_type (uintptrknd) = "mac#%"
fun g1uint_compare_uintptr : g1uint_compare_type (uintptrknd) = "mac#%"
fun g1uint_max_uintptr : g1uint_max_type (uintptrknd) = "mac#%"
fun g1uint_min_uintptr : g1uint_min_type (uintptrknd) = "mac#%"
fun g1uint_isgtz_uintptr : g1uint_isgtz_type (uintptrknd) = "mac#%"
fun g1uint_iseqz_uintptr : g1uint_iseqz_type (uintptrknd) = "mac#%"
fun g1uint_isneqz_uintptr : g1uint_isneqz_type (uintptrknd) = "mac#%"
//
(* ****** ****** *)
//
macdef i2ptr (x) = g1int2int_int_intptr (,(x))
//
macdef u2ptr (x) = g1uint2uint_uint_uintptr (,(x))
//
(* ****** ****** *)

(* end of [integer_ptr.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: gmhwxiATgmailDOTcom *)
(* Start time: January, 2013 *)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/integer_fixed.atxt
** Time of generation: Fri Aug 18 03:29:51 2017
*)

(* ****** ****** *)
//
// HX: for unindexed integer types
//
(* ****** ****** *)

sortdef tk = tkind

(* ****** ****** *)
//
stadef int8knd = int8_kind
stadef int16knd = int16_kind
stadef int32knd = int32_kind
stadef int64knd = int64_kind
//
stadef uint8knd = uint8_kind
stadef uint16knd = uint16_kind
stadef uint32knd = uint32_kind
stadef uint64knd = uint64_kind
//
(* ****** ****** *)
//
fun g0int2int_int8_int (x: int8):<> int = "mac#%"
fun g0int2int_int16_int (x: int16):<> int = "mac#%"
fun g0int2int_int32_int (x: int32):<> int = "mac#%"
fun g0int2int_int64_int (x: int64):<> int = "mac#%"
//
(* ****** ****** *)
//
fun g0int_neg_int8 (x: int8):<> int8 = "mac#%"
fun g0int_abs_int8 (x: int8):<> int8 = "mac#%"
fun g0int_succ_int8 (x: int8):<> int8 = "mac#%"
fun g0int_pred_int8 (x: int8):<> int8 = "mac#%"
fun g0int_half_int8 (x: int8):<> int8 = "mac#%"
fun g0int_asl_int8 (x: int8, n: intGte(0)):<> int8 = "mac#%"
fun g0int_asr_int8 (x: int8, n: intGte(0)):<> int8 = "mac#%"
fun g0int_add_int8 (x: int8, y: int8):<> int8 = "mac#%"
fun g0int_sub_int8 (x: int8, y: int8):<> int8 = "mac#%"
fun g0int_mul_int8 (x: int8, y: int8):<> int8 = "mac#%"
fun g0int_div_int8 (x: int8, y: int8):<> int8 = "mac#%"
fun g0int_mod_int8 (x: int8, y: int8):<> int8 = "mac#%"
fun g0int_lt_int8 (x: int8, y: int8):<> bool = "mac#%"
fun g0int_lte_int8 (x: int8, y: int8):<> bool = "mac#%"
fun g0int_gt_int8 (x: int8, y: int8):<> bool = "mac#%"
fun g0int_gte_int8 (x: int8, y: int8):<> bool = "mac#%"
fun g0int_eq_int8 (x: int8, y: int8):<> bool = "mac#%"
fun g0int_neq_int8 (x: int8, y: int8):<> bool = "mac#%"
fun g0int_compare_int8 (x: int8, y: int8):<> int = "mac#%"
fun g0int_max_int8 (x: int8, y: int8):<> int8 = "mac#%"
fun g0int_min_int8 (x: int8, y: int8):<> int8 = "mac#%"
fun g0int_isltz_int8 (x: int8):<> bool = "mac#%"
fun g0int_isltez_int8 (x: int8):<> bool = "mac#%"
fun g0int_isgtz_int8 (x: int8):<> bool = "mac#%"
fun g0int_isgtez_int8 (x: int8):<> bool = "mac#%"
fun g0int_iseqz_int8 (x: int8):<> bool = "mac#%"
fun g0int_isneqz_int8 (x: int8):<> bool = "mac#%"
//
fun g0int_neg_int16 (x: int16):<> int16 = "mac#%"
fun g0int_abs_int16 (x: int16):<> int16 = "mac#%"
fun g0int_succ_int16 (x: int16):<> int16 = "mac#%"
fun g0int_pred_int16 (x: int16):<> int16 = "mac#%"
fun g0int_half_int16 (x: int16):<> int16 = "mac#%"
fun g0int_asl_int16 (x: int16, n: intGte(0)):<> int16 = "mac#%"
fun g0int_asr_int16 (x: int16, n: intGte(0)):<> int16 = "mac#%"
fun g0int_add_int16 (x: int16, y: int16):<> int16 = "mac#%"
fun g0int_sub_int16 (x: int16, y: int16):<> int16 = "mac#%"
fun g0int_mul_int16 (x: int16, y: int16):<> int16 = "mac#%"
fun g0int_div_int16 (x: int16, y: int16):<> int16 = "mac#%"
fun g0int_mod_int16 (x: int16, y: int16):<> int16 = "mac#%"
fun g0int_lt_int16 (x: int16, y: int16):<> bool = "mac#%"
fun g0int_lte_int16 (x: int16, y: int16):<> bool = "mac#%"
fun g0int_gt_int16 (x: int16, y: int16):<> bool = "mac#%"
fun g0int_gte_int16 (x: int16, y: int16):<> bool = "mac#%"
fun g0int_eq_int16 (x: int16, y: int16):<> bool = "mac#%"
fun g0int_neq_int16 (x: int16, y: int16):<> bool = "mac#%"
fun g0int_compare_int16 (x: int16, y: int16):<> int = "mac#%"
fun g0int_max_int16 (x: int16, y: int16):<> int16 = "mac#%"
fun g0int_min_int16 (x: int16, y: int16):<> int16 = "mac#%"
fun g0int_isltz_int16 (x: int16):<> bool = "mac#%"
fun g0int_isltez_int16 (x: int16):<> bool = "mac#%"
fun g0int_isgtz_int16 (x: int16):<> bool = "mac#%"
fun g0int_isgtez_int16 (x: int16):<> bool = "mac#%"
fun g0int_iseqz_int16 (x: int16):<> bool = "mac#%"
fun g0int_isneqz_int16 (x: int16):<> bool = "mac#%"
//
fun g0int_neg_int32 (x: int32):<> int32 = "mac#%"
fun g0int_abs_int32 (x: int32):<> int32 = "mac#%"
fun g0int_succ_int32 (x: int32):<> int32 = "mac#%"
fun g0int_pred_int32 (x: int32):<> int32 = "mac#%"
fun g0int_half_int32 (x: int32):<> int32 = "mac#%"
fun g0int_asl_int32 (x: int32, n: intGte(0)):<> int32 = "mac#%"
fun g0int_asr_int32 (x: int32, n: intGte(0)):<> int32 = "mac#%"
fun g0int_add_int32 (x: int32, y: int32):<> int32 = "mac#%"
fun g0int_sub_int32 (x: int32, y: int32):<> int32 = "mac#%"
fun g0int_mul_int32 (x: int32, y: int32):<> int32 = "mac#%"
fun g0int_div_int32 (x: int32, y: int32):<> int32 = "mac#%"
fun g0int_mod_int32 (x: int32, y: int32):<> int32 = "mac#%"
fun g0int_lt_int32 (x: int32, y: int32):<> bool = "mac#%"
fun g0int_lte_int32 (x: int32, y: int32):<> bool = "mac#%"
fun g0int_gt_int32 (x: int32, y: int32):<> bool = "mac#%"
fun g0int_gte_int32 (x: int32, y: int32):<> bool = "mac#%"
fun g0int_eq_int32 (x: int32, y: int32):<> bool = "mac#%"
fun g0int_neq_int32 (x: int32, y: int32):<> bool = "mac#%"
fun g0int_compare_int32 (x: int32, y: int32):<> int = "mac#%"
fun g0int_max_int32 (x: int32, y: int32):<> int32 = "mac#%"
fun g0int_min_int32 (x: int32, y: int32):<> int32 = "mac#%"
fun g0int_isltz_int32 (x: int32):<> bool = "mac#%"
fun g0int_isltez_int32 (x: int32):<> bool = "mac#%"
fun g0int_isgtz_int32 (x: int32):<> bool = "mac#%"
fun g0int_isgtez_int32 (x: int32):<> bool = "mac#%"
fun g0int_iseqz_int32 (x: int32):<> bool = "mac#%"
fun g0int_isneqz_int32 (x: int32):<> bool = "mac#%"
//
fun g0int_neg_int64 (x: int64):<> int64 = "mac#%"
fun g0int_abs_int64 (x: int64):<> int64 = "mac#%"
fun g0int_succ_int64 (x: int64):<> int64 = "mac#%"
fun g0int_pred_int64 (x: int64):<> int64 = "mac#%"
fun g0int_half_int64 (x: int64):<> int64 = "mac#%"
fun g0int_asl_int64 (x: int64, n: intGte(0)):<> int64 = "mac#%"
fun g0int_asr_int64 (x: int64, n: intGte(0)):<> int64 = "mac#%"
fun g0int_add_int64 (x: int64, y: int64):<> int64 = "mac#%"
fun g0int_sub_int64 (x: int64, y: int64):<> int64 = "mac#%"
fun g0int_mul_int64 (x: int64, y: int64):<> int64 = "mac#%"
fun g0int_div_int64 (x: int64, y: int64):<> int64 = "mac#%"
fun g0int_mod_int64 (x: int64, y: int64):<> int64 = "mac#%"
fun g0int_lt_int64 (x: int64, y: int64):<> bool = "mac#%"
fun g0int_lte_int64 (x: int64, y: int64):<> bool = "mac#%"
fun g0int_gt_int64 (x: int64, y: int64):<> bool = "mac#%"
fun g0int_gte_int64 (x: int64, y: int64):<> bool = "mac#%"
fun g0int_eq_int64 (x: int64, y: int64):<> bool = "mac#%"
fun g0int_neq_int64 (x: int64, y: int64):<> bool = "mac#%"
fun g0int_compare_int64 (x: int64, y: int64):<> int = "mac#%"
fun g0int_max_int64 (x: int64, y: int64):<> int64 = "mac#%"
fun g0int_min_int64 (x: int64, y: int64):<> int64 = "mac#%"
fun g0int_isltz_int64 (x: int64):<> bool = "mac#%"
fun g0int_isltez_int64 (x: int64):<> bool = "mac#%"
fun g0int_isgtz_int64 (x: int64):<> bool = "mac#%"
fun g0int_isgtez_int64 (x: int64):<> bool = "mac#%"
fun g0int_iseqz_int64 (x: int64):<> bool = "mac#%"
fun g0int_isneqz_int64 (x: int64):<> bool = "mac#%"
//
(* ****** ****** *)

fun print_int8 (int8): void = "mac#%"
fun prerr_int8 (int8): void = "mac#%"
fun fprint_int8 : fprint_type (int8) = "mac#%"
overload print with print_int8
overload prerr with prerr_int8
overload fprint with fprint_int8

fun print_int16 (int16): void = "mac#%"
fun prerr_int16 (int16): void = "mac#%"
fun fprint_int16 : fprint_type (int16) = "mac#%"
overload print with print_int16
overload prerr with prerr_int16
overload fprint with fprint_int16

fun print_int32 (int32): void = "mac#%"
fun prerr_int32 (int32): void = "mac#%"
fun fprint_int32 : fprint_type (int32) = "mac#%"
overload print with print_int32
overload prerr with prerr_int32
overload fprint with fprint_int32

fun print_int64 (int64): void = "mac#%"
fun prerr_int64 (int64): void = "mac#%"
fun fprint_int64 : fprint_type (int64) = "mac#%"
overload print with print_int64
overload prerr with prerr_int64
overload fprint with fprint_int64


(* ****** ****** *)
//
fun g0int2uint_int8_uint (x: int8):<> uint = "mac#%"
fun g0int2uint_int16_uint (x: int16):<> uint = "mac#%"
fun g0int2uint_int32_uint (x: int32):<> uint = "mac#%"
fun g0int2uint_int64_uint (x: int64):<> uint = "mac#%"
//
fun g0uint2int_uint8_int (x: uint8):<> int = "mac#%"
fun g0uint2int_uint16_int (x: uint16):<> int = "mac#%"
fun g0uint2int_uint32_int (x: uint32):<> int = "mac#%"
fun g0uint2int_uint64_int (x: uint64):<> int = "mac#%"
//
fun g0uint2uint_uint8_uint (x: uint8):<> uint = "mac#%"
fun g0uint2uint_uint16_uint (x: uint16):<> uint = "mac#%"
fun g0uint2uint_uint32_uint (x: uint32):<> uint = "mac#%"
fun g0uint2uint_uint64_uint (x: uint64):<> uint = "mac#%"
//
(* ****** ****** *)
//
fun g0uint_succ_uint8 (x: uint8):<> uint8 = "mac#%"
fun g0uint_pred_uint8 (x: uint8):<> uint8 = "mac#%"
fun g0uint_half_uint8 (x: uint8):<> uint8 = "mac#%"
fun g0uint_add_uint8 (x: uint8, y: uint8):<> uint8 = "mac#%"
fun g0uint_sub_uint8 (x: uint8, y: uint8):<> uint8 = "mac#%"
fun g0uint_mul_uint8 (x: uint8, y: uint8):<> uint8 = "mac#%"
fun g0uint_div_uint8 (x: uint8, y: uint8):<> uint8 = "mac#%"
fun g0uint_mod_uint8 (x: uint8, y: uint8):<> uint8 = "mac#%"
fun g0uint_lsl_uint8 (x: uint8, n: intGte(0)):<> uint8 = "mac#%"
fun g0uint_lsr_uint8 (x: uint8, n: intGte(0)):<> uint8 = "mac#%"
fun g0uint_lnot_uint8 (x: uint8):<> uint8 = "mac#%"
fun g0uint_lor_uint8 (x: uint8, y: uint8):<> uint8 = "mac#%"
fun g0uint_lxor_uint8 (x: uint8, y: uint8):<> uint8 = "mac#%"
fun g0uint_land_uint8 (x: uint8, y: uint8):<> uint8 = "mac#%"
fun g0uint_lt_uint8 (x: uint8, y: uint8):<> bool = "mac#%"
fun g0uint_lte_uint8 (x: uint8, y: uint8):<> bool = "mac#%"
fun g0uint_gt_uint8 (x: uint8, y: uint8):<> bool = "mac#%"
fun g0uint_gte_uint8 (x: uint8, y: uint8):<> bool = "mac#%"
fun g0uint_eq_uint8 (x: uint8, y: uint8):<> bool = "mac#%"
fun g0uint_neq_uint8 (x: uint8, y: uint8):<> bool = "mac#%"
fun g0uint_compare_uint8 (x: uint8, y: uint8):<> int = "mac#%"
fun g0uint_max_uint8 (x: uint8, y: uint8):<> uint8 = "mac#%"
fun g0uint_min_uint8 (x: uint8, y: uint8):<> uint8 = "mac#%"
fun g0uint_isgtz_uint8 (x: uint8):<> bool = "mac#%"
fun g0uint_iseqz_uint8 (x: uint8):<> bool = "mac#%"
fun g0uint_isneqz_uint8 (x: uint8):<> bool = "mac#%"
//
fun g0uint_succ_uint16 (x: uint16):<> uint16 = "mac#%"
fun g0uint_pred_uint16 (x: uint16):<> uint16 = "mac#%"
fun g0uint_half_uint16 (x: uint16):<> uint16 = "mac#%"
fun g0uint_add_uint16 (x: uint16, y: uint16):<> uint16 = "mac#%"
fun g0uint_sub_uint16 (x: uint16, y: uint16):<> uint16 = "mac#%"
fun g0uint_mul_uint16 (x: uint16, y: uint16):<> uint16 = "mac#%"
fun g0uint_div_uint16 (x: uint16, y: uint16):<> uint16 = "mac#%"
fun g0uint_mod_uint16 (x: uint16, y: uint16):<> uint16 = "mac#%"
fun g0uint_lsl_uint16 (x: uint16, n: intGte(0)):<> uint16 = "mac#%"
fun g0uint_lsr_uint16 (x: uint16, n: intGte(0)):<> uint16 = "mac#%"
fun g0uint_lnot_uint16 (x: uint16):<> uint16 = "mac#%"
fun g0uint_lor_uint16 (x: uint16, y: uint16):<> uint16 = "mac#%"
fun g0uint_lxor_uint16 (x: uint16, y: uint16):<> uint16 = "mac#%"
fun g0uint_land_uint16 (x: uint16, y: uint16):<> uint16 = "mac#%"
fun g0uint_lt_uint16 (x: uint16, y: uint16):<> bool = "mac#%"
fun g0uint_lte_uint16 (x: uint16, y: uint16):<> bool = "mac#%"
fun g0uint_gt_uint16 (x: uint16, y: uint16):<> bool = "mac#%"
fun g0uint_gte_uint16 (x: uint16, y: uint16):<> bool = "mac#%"
fun g0uint_eq_uint16 (x: uint16, y: uint16):<> bool = "mac#%"
fun g0uint_neq_uint16 (x: uint16, y: uint16):<> bool = "mac#%"
fun g0uint_compare_uint16 (x: uint16, y: uint16):<> int = "mac#%"
fun g0uint_max_uint16 (x: uint16, y: uint16):<> uint16 = "mac#%"
fun g0uint_min_uint16 (x: uint16, y: uint16):<> uint16 = "mac#%"
fun g0uint_isgtz_uint16 (x: uint16):<> bool = "mac#%"
fun g0uint_iseqz_uint16 (x: uint16):<> bool = "mac#%"
fun g0uint_isneqz_uint16 (x: uint16):<> bool = "mac#%"
//
fun g0uint_succ_uint32 (x: uint32):<> uint32 = "mac#%"
fun g0uint_pred_uint32 (x: uint32):<> uint32 = "mac#%"
fun g0uint_half_uint32 (x: uint32):<> uint32 = "mac#%"
fun g0uint_add_uint32 (x: uint32, y: uint32):<> uint32 = "mac#%"
fun g0uint_sub_uint32 (x: uint32, y: uint32):<> uint32 = "mac#%"
fun g0uint_mul_uint32 (x: uint32, y: uint32):<> uint32 = "mac#%"
fun g0uint_div_uint32 (x: uint32, y: uint32):<> uint32 = "mac#%"
fun g0uint_mod_uint32 (x: uint32, y: uint32):<> uint32 = "mac#%"
fun g0uint_lsl_uint32 (x: uint32, n: intGte(0)):<> uint32 = "mac#%"
fun g0uint_lsr_uint32 (x: uint32, n: intGte(0)):<> uint32 = "mac#%"
fun g0uint_lnot_uint32 (x: uint32):<> uint32 = "mac#%"
fun g0uint_lor_uint32 (x: uint32, y: uint32):<> uint32 = "mac#%"
fun g0uint_lxor_uint32 (x: uint32, y: uint32):<> uint32 = "mac#%"
fun g0uint_land_uint32 (x: uint32, y: uint32):<> uint32 = "mac#%"
fun g0uint_lt_uint32 (x: uint32, y: uint32):<> bool = "mac#%"
fun g0uint_lte_uint32 (x: uint32, y: uint32):<> bool = "mac#%"
fun g0uint_gt_uint32 (x: uint32, y: uint32):<> bool = "mac#%"
fun g0uint_gte_uint32 (x: uint32, y: uint32):<> bool = "mac#%"
fun g0uint_eq_uint32 (x: uint32, y: uint32):<> bool = "mac#%"
fun g0uint_neq_uint32 (x: uint32, y: uint32):<> bool = "mac#%"
fun g0uint_compare_uint32 (x: uint32, y: uint32):<> int = "mac#%"
fun g0uint_max_uint32 (x: uint32, y: uint32):<> uint32 = "mac#%"
fun g0uint_min_uint32 (x: uint32, y: uint32):<> uint32 = "mac#%"
fun g0uint_isgtz_uint32 (x: uint32):<> bool = "mac#%"
fun g0uint_iseqz_uint32 (x: uint32):<> bool = "mac#%"
fun g0uint_isneqz_uint32 (x: uint32):<> bool = "mac#%"
//
fun g0uint_succ_uint64 (x: uint64):<> uint64 = "mac#%"
fun g0uint_pred_uint64 (x: uint64):<> uint64 = "mac#%"
fun g0uint_half_uint64 (x: uint64):<> uint64 = "mac#%"
fun g0uint_add_uint64 (x: uint64, y: uint64):<> uint64 = "mac#%"
fun g0uint_sub_uint64 (x: uint64, y: uint64):<> uint64 = "mac#%"
fun g0uint_mul_uint64 (x: uint64, y: uint64):<> uint64 = "mac#%"
fun g0uint_div_uint64 (x: uint64, y: uint64):<> uint64 = "mac#%"
fun g0uint_mod_uint64 (x: uint64, y: uint64):<> uint64 = "mac#%"
fun g0uint_lsl_uint64 (x: uint64, n: intGte(0)):<> uint64 = "mac#%"
fun g0uint_lsr_uint64 (x: uint64, n: intGte(0)):<> uint64 = "mac#%"
fun g0uint_lnot_uint64 (x: uint64):<> uint64 = "mac#%"
fun g0uint_lor_uint64 (x: uint64, y: uint64):<> uint64 = "mac#%"
fun g0uint_lxor_uint64 (x: uint64, y: uint64):<> uint64 = "mac#%"
fun g0uint_land_uint64 (x: uint64, y: uint64):<> uint64 = "mac#%"
fun g0uint_lt_uint64 (x: uint64, y: uint64):<> bool = "mac#%"
fun g0uint_lte_uint64 (x: uint64, y: uint64):<> bool = "mac#%"
fun g0uint_gt_uint64 (x: uint64, y: uint64):<> bool = "mac#%"
fun g0uint_gte_uint64 (x: uint64, y: uint64):<> bool = "mac#%"
fun g0uint_eq_uint64 (x: uint64, y: uint64):<> bool = "mac#%"
fun g0uint_neq_uint64 (x: uint64, y: uint64):<> bool = "mac#%"
fun g0uint_compare_uint64 (x: uint64, y: uint64):<> int = "mac#%"
fun g0uint_max_uint64 (x: uint64, y: uint64):<> uint64 = "mac#%"
fun g0uint_min_uint64 (x: uint64, y: uint64):<> uint64 = "mac#%"
fun g0uint_isgtz_uint64 (x: uint64):<> bool = "mac#%"
fun g0uint_iseqz_uint64 (x: uint64):<> bool = "mac#%"
fun g0uint_isneqz_uint64 (x: uint64):<> bool = "mac#%"
//
(* ****** ****** *)

fun print_uint8 (uint8): void = "mac#%"
fun prerr_uint8 (uint8): void = "mac#%"
fun fprint_uint8 : fprint_type (uint8) = "mac#%"
overload print with print_uint8
overload prerr with prerr_uint8
overload fprint with fprint_uint8

fun print_uint16 (uint16): void = "mac#%"
fun prerr_uint16 (uint16): void = "mac#%"
fun fprint_uint16 : fprint_type (uint16) = "mac#%"
overload print with print_uint16
overload prerr with prerr_uint16
overload fprint with fprint_uint16

fun print_uint32 (uint32): void = "mac#%"
fun prerr_uint32 (uint32): void = "mac#%"
fun fprint_uint32 : fprint_type (uint32) = "mac#%"
overload print with print_uint32
overload prerr with prerr_uint32
overload fprint with fprint_uint32

fun print_uint64 (uint64): void = "mac#%"
fun prerr_uint64 (uint64): void = "mac#%"
fun fprint_uint64 : fprint_type (uint64) = "mac#%"
overload print with print_uint64
overload prerr with prerr_uint64
overload fprint with fprint_uint64


(* ****** ****** *)
//
fun g1int_neg_int8 : g1int_neg_type (int8knd) = "mac#%"
fun g1int_abs_int8 : g1int_abs_type (int8knd) = "mac#%"
fun g1int_succ_int8 : g1int_succ_type (int8knd) = "mac#%"
fun g1int_pred_int8 : g1int_pred_type (int8knd) = "mac#%"
fun g1int_half_int8 : g1int_half_type (int8knd) = "mac#%"
fun g1int_add_int8 : g1int_add_type (int8knd) = "mac#%"
fun g1int_sub_int8 : g1int_sub_type (int8knd) = "mac#%"
fun g1int_mul_int8 : g1int_mul_type (int8knd) = "mac#%"
fun g1int_div_int8 : g1int_div_type (int8knd) = "mac#%"
fun g1int_nmod_int8 : g1int_nmod_type (int8knd) = "mac#%"
fun g1int_lt_int8 : g1int_lt_type (int8knd) = "mac#%"
fun g1int_lte_int8 : g1int_lte_type (int8knd) = "mac#%"
fun g1int_gt_int8 : g1int_gt_type (int8knd) = "mac#%"
fun g1int_gte_int8 : g1int_gte_type (int8knd) = "mac#%"
fun g1int_eq_int8 : g1int_eq_type (int8knd) = "mac#%"
fun g1int_neq_int8 : g1int_neq_type (int8knd) = "mac#%"
fun g1int_compare_int8 : g1int_compare_type (int8knd) = "mac#%"
fun g1int_max_int8 : g1int_max_type (int8knd) = "mac#%"
fun g1int_min_int8 : g1int_min_type (int8knd) = "mac#%"
fun g1int_isltz_int8 : g1int_isltz_type (int8knd) = "mac#%"
fun g1int_isltez_int8 : g1int_isltez_type (int8knd) = "mac#%"
fun g1int_isgtz_int8 : g1int_isgtz_type (int8knd) = "mac#%"
fun g1int_isgtez_int8 : g1int_isgtez_type (int8knd) = "mac#%"
fun g1int_iseqz_int8 : g1int_iseqz_type (int8knd) = "mac#%"
fun g1int_isneqz_int8 : g1int_isneqz_type (int8knd) = "mac#%"
//
fun g1int_neg_int16 : g1int_neg_type (int16knd) = "mac#%"
fun g1int_abs_int16 : g1int_abs_type (int16knd) = "mac#%"
fun g1int_succ_int16 : g1int_succ_type (int16knd) = "mac#%"
fun g1int_pred_int16 : g1int_pred_type (int16knd) = "mac#%"
fun g1int_half_int16 : g1int_half_type (int16knd) = "mac#%"
fun g1int_add_int16 : g1int_add_type (int16knd) = "mac#%"
fun g1int_sub_int16 : g1int_sub_type (int16knd) = "mac#%"
fun g1int_mul_int16 : g1int_mul_type (int16knd) = "mac#%"
fun g1int_div_int16 : g1int_div_type (int16knd) = "mac#%"
fun g1int_nmod_int16 : g1int_nmod_type (int16knd) = "mac#%"
fun g1int_lt_int16 : g1int_lt_type (int16knd) = "mac#%"
fun g1int_lte_int16 : g1int_lte_type (int16knd) = "mac#%"
fun g1int_gt_int16 : g1int_gt_type (int16knd) = "mac#%"
fun g1int_gte_int16 : g1int_gte_type (int16knd) = "mac#%"
fun g1int_eq_int16 : g1int_eq_type (int16knd) = "mac#%"
fun g1int_neq_int16 : g1int_neq_type (int16knd) = "mac#%"
fun g1int_compare_int16 : g1int_compare_type (int16knd) = "mac#%"
fun g1int_max_int16 : g1int_max_type (int16knd) = "mac#%"
fun g1int_min_int16 : g1int_min_type (int16knd) = "mac#%"
fun g1int_isltz_int16 : g1int_isltz_type (int16knd) = "mac#%"
fun g1int_isltez_int16 : g1int_isltez_type (int16knd) = "mac#%"
fun g1int_isgtz_int16 : g1int_isgtz_type (int16knd) = "mac#%"
fun g1int_isgtez_int16 : g1int_isgtez_type (int16knd) = "mac#%"
fun g1int_iseqz_int16 : g1int_iseqz_type (int16knd) = "mac#%"
fun g1int_isneqz_int16 : g1int_isneqz_type (int16knd) = "mac#%"
//
fun g1int_neg_int32 : g1int_neg_type (int32knd) = "mac#%"
fun g1int_abs_int32 : g1int_abs_type (int32knd) = "mac#%"
fun g1int_succ_int32 : g1int_succ_type (int32knd) = "mac#%"
fun g1int_pred_int32 : g1int_pred_type (int32knd) = "mac#%"
fun g1int_half_int32 : g1int_half_type (int32knd) = "mac#%"
fun g1int_add_int32 : g1int_add_type (int32knd) = "mac#%"
fun g1int_sub_int32 : g1int_sub_type (int32knd) = "mac#%"
fun g1int_mul_int32 : g1int_mul_type (int32knd) = "mac#%"
fun g1int_div_int32 : g1int_div_type (int32knd) = "mac#%"
fun g1int_nmod_int32 : g1int_nmod_type (int32knd) = "mac#%"
fun g1int_lt_int32 : g1int_lt_type (int32knd) = "mac#%"
fun g1int_lte_int32 : g1int_lte_type (int32knd) = "mac#%"
fun g1int_gt_int32 : g1int_gt_type (int32knd) = "mac#%"
fun g1int_gte_int32 : g1int_gte_type (int32knd) = "mac#%"
fun g1int_eq_int32 : g1int_eq_type (int32knd) = "mac#%"
fun g1int_neq_int32 : g1int_neq_type (int32knd) = "mac#%"
fun g1int_compare_int32 : g1int_compare_type (int32knd) = "mac#%"
fun g1int_max_int32 : g1int_max_type (int32knd) = "mac#%"
fun g1int_min_int32 : g1int_min_type (int32knd) = "mac#%"
fun g1int_isltz_int32 : g1int_isltz_type (int32knd) = "mac#%"
fun g1int_isltez_int32 : g1int_isltez_type (int32knd) = "mac#%"
fun g1int_isgtz_int32 : g1int_isgtz_type (int32knd) = "mac#%"
fun g1int_isgtez_int32 : g1int_isgtez_type (int32knd) = "mac#%"
fun g1int_iseqz_int32 : g1int_iseqz_type (int32knd) = "mac#%"
fun g1int_isneqz_int32 : g1int_isneqz_type (int32knd) = "mac#%"
//
fun g1int_neg_int64 : g1int_neg_type (int64knd) = "mac#%"
fun g1int_abs_int64 : g1int_abs_type (int64knd) = "mac#%"
fun g1int_succ_int64 : g1int_succ_type (int64knd) = "mac#%"
fun g1int_pred_int64 : g1int_pred_type (int64knd) = "mac#%"
fun g1int_half_int64 : g1int_half_type (int64knd) = "mac#%"
fun g1int_add_int64 : g1int_add_type (int64knd) = "mac#%"
fun g1int_sub_int64 : g1int_sub_type (int64knd) = "mac#%"
fun g1int_mul_int64 : g1int_mul_type (int64knd) = "mac#%"
fun g1int_div_int64 : g1int_div_type (int64knd) = "mac#%"
fun g1int_nmod_int64 : g1int_nmod_type (int64knd) = "mac#%"
fun g1int_lt_int64 : g1int_lt_type (int64knd) = "mac#%"
fun g1int_lte_int64 : g1int_lte_type (int64knd) = "mac#%"
fun g1int_gt_int64 : g1int_gt_type (int64knd) = "mac#%"
fun g1int_gte_int64 : g1int_gte_type (int64knd) = "mac#%"
fun g1int_eq_int64 : g1int_eq_type (int64knd) = "mac#%"
fun g1int_neq_int64 : g1int_neq_type (int64knd) = "mac#%"
fun g1int_compare_int64 : g1int_compare_type (int64knd) = "mac#%"
fun g1int_max_int64 : g1int_max_type (int64knd) = "mac#%"
fun g1int_min_int64 : g1int_min_type (int64knd) = "mac#%"
fun g1int_isltz_int64 : g1int_isltz_type (int64knd) = "mac#%"
fun g1int_isltez_int64 : g1int_isltez_type (int64knd) = "mac#%"
fun g1int_isgtz_int64 : g1int_isgtz_type (int64knd) = "mac#%"
fun g1int_isgtez_int64 : g1int_isgtez_type (int64knd) = "mac#%"
fun g1int_iseqz_int64 : g1int_iseqz_type (int64knd) = "mac#%"
fun g1int_isneqz_int64 : g1int_isneqz_type (int64knd) = "mac#%"
//
(* ****** ****** *)
//
fun g1uint_succ_uint8 : g1uint_succ_type (uint8knd) = "mac#%"
fun g1uint_pred_uint8 : g1uint_pred_type (uint8knd) = "mac#%"
fun g1uint_half_uint8 : g1uint_half_type (uint8knd) = "mac#%"
fun g1uint_add_uint8 : g1uint_add_type (uint8knd) = "mac#%"
fun g1uint_sub_uint8 : g1uint_sub_type (uint8knd) = "mac#%"
fun g1uint_mul_uint8 : g1uint_mul_type (uint8knd) = "mac#%"
fun g1uint_div_uint8 : g1uint_div_type (uint8knd) = "mac#%"
fun g1uint_mod_uint8 : g1uint_mod_type (uint8knd) = "mac#%"
fun g1uint_lt_uint8 : g1uint_lt_type (uint8knd) = "mac#%"
fun g1uint_lte_uint8 : g1uint_lte_type (uint8knd) = "mac#%"
fun g1uint_gt_uint8 : g1uint_gt_type (uint8knd) = "mac#%"
fun g1uint_gte_uint8 : g1uint_gte_type (uint8knd) = "mac#%"
fun g1uint_eq_uint8 : g1uint_eq_type (uint8knd) = "mac#%"
fun g1uint_neq_uint8 : g1uint_neq_type (uint8knd) = "mac#%"
fun g1uint_compare_uint8 : g1uint_compare_type (uint8knd) = "mac#%"
fun g1uint_max_uint8 : g1uint_max_type (uint8knd) = "mac#%"
fun g1uint_min_uint8 : g1uint_min_type (uint8knd) = "mac#%"
fun g1uint_isgtz_uint8 : g1uint_isgtz_type (uint8knd) = "mac#%"
fun g1uint_iseqz_uint8 : g1uint_iseqz_type (uint8knd) = "mac#%"
fun g1uint_isneqz_uint8 : g1uint_isneqz_type (uint8knd) = "mac#%"
//
fun g1uint_succ_uint16 : g1uint_succ_type (uint16knd) = "mac#%"
fun g1uint_pred_uint16 : g1uint_pred_type (uint16knd) = "mac#%"
fun g1uint_half_uint16 : g1uint_half_type (uint16knd) = "mac#%"
fun g1uint_add_uint16 : g1uint_add_type (uint16knd) = "mac#%"
fun g1uint_sub_uint16 : g1uint_sub_type (uint16knd) = "mac#%"
fun g1uint_mul_uint16 : g1uint_mul_type (uint16knd) = "mac#%"
fun g1uint_div_uint16 : g1uint_div_type (uint16knd) = "mac#%"
fun g1uint_mod_uint16 : g1uint_mod_type (uint16knd) = "mac#%"
fun g1uint_lt_uint16 : g1uint_lt_type (uint16knd) = "mac#%"
fun g1uint_lte_uint16 : g1uint_lte_type (uint16knd) = "mac#%"
fun g1uint_gt_uint16 : g1uint_gt_type (uint16knd) = "mac#%"
fun g1uint_gte_uint16 : g1uint_gte_type (uint16knd) = "mac#%"
fun g1uint_eq_uint16 : g1uint_eq_type (uint16knd) = "mac#%"
fun g1uint_neq_uint16 : g1uint_neq_type (uint16knd) = "mac#%"
fun g1uint_compare_uint16 : g1uint_compare_type (uint16knd) = "mac#%"
fun g1uint_max_uint16 : g1uint_max_type (uint16knd) = "mac#%"
fun g1uint_min_uint16 : g1uint_min_type (uint16knd) = "mac#%"
fun g1uint_isgtz_uint16 : g1uint_isgtz_type (uint16knd) = "mac#%"
fun g1uint_iseqz_uint16 : g1uint_iseqz_type (uint16knd) = "mac#%"
fun g1uint_isneqz_uint16 : g1uint_isneqz_type (uint16knd) = "mac#%"
//
fun g1uint_succ_uint32 : g1uint_succ_type (uint32knd) = "mac#%"
fun g1uint_pred_uint32 : g1uint_pred_type (uint32knd) = "mac#%"
fun g1uint_half_uint32 : g1uint_half_type (uint32knd) = "mac#%"
fun g1uint_add_uint32 : g1uint_add_type (uint32knd) = "mac#%"
fun g1uint_sub_uint32 : g1uint_sub_type (uint32knd) = "mac#%"
fun g1uint_mul_uint32 : g1uint_mul_type (uint32knd) = "mac#%"
fun g1uint_div_uint32 : g1uint_div_type (uint32knd) = "mac#%"
fun g1uint_mod_uint32 : g1uint_mod_type (uint32knd) = "mac#%"
fun g1uint_lt_uint32 : g1uint_lt_type (uint32knd) = "mac#%"
fun g1uint_lte_uint32 : g1uint_lte_type (uint32knd) = "mac#%"
fun g1uint_gt_uint32 : g1uint_gt_type (uint32knd) = "mac#%"
fun g1uint_gte_uint32 : g1uint_gte_type (uint32knd) = "mac#%"
fun g1uint_eq_uint32 : g1uint_eq_type (uint32knd) = "mac#%"
fun g1uint_neq_uint32 : g1uint_neq_type (uint32knd) = "mac#%"
fun g1uint_compare_uint32 : g1uint_compare_type (uint32knd) = "mac#%"
fun g1uint_max_uint32 : g1uint_max_type (uint32knd) = "mac#%"
fun g1uint_min_uint32 : g1uint_min_type (uint32knd) = "mac#%"
fun g1uint_isgtz_uint32 : g1uint_isgtz_type (uint32knd) = "mac#%"
fun g1uint_iseqz_uint32 : g1uint_iseqz_type (uint32knd) = "mac#%"
fun g1uint_isneqz_uint32 : g1uint_isneqz_type (uint32knd) = "mac#%"
//
fun g1uint_succ_uint64 : g1uint_succ_type (uint64knd) = "mac#%"
fun g1uint_pred_uint64 : g1uint_pred_type (uint64knd) = "mac#%"
fun g1uint_half_uint64 : g1uint_half_type (uint64knd) = "mac#%"
fun g1uint_add_uint64 : g1uint_add_type (uint64knd) = "mac#%"
fun g1uint_sub_uint64 : g1uint_sub_type (uint64knd) = "mac#%"
fun g1uint_mul_uint64 : g1uint_mul_type (uint64knd) = "mac#%"
fun g1uint_div_uint64 : g1uint_div_type (uint64knd) = "mac#%"
fun g1uint_mod_uint64 : g1uint_mod_type (uint64knd) = "mac#%"
fun g1uint_lt_uint64 : g1uint_lt_type (uint64knd) = "mac#%"
fun g1uint_lte_uint64 : g1uint_lte_type (uint64knd) = "mac#%"
fun g1uint_gt_uint64 : g1uint_gt_type (uint64knd) = "mac#%"
fun g1uint_gte_uint64 : g1uint_gte_type (uint64knd) = "mac#%"
fun g1uint_eq_uint64 : g1uint_eq_type (uint64knd) = "mac#%"
fun g1uint_neq_uint64 : g1uint_neq_type (uint64knd) = "mac#%"
fun g1uint_compare_uint64 : g1uint_compare_type (uint64knd) = "mac#%"
fun g1uint_max_uint64 : g1uint_max_type (uint64knd) = "mac#%"
fun g1uint_min_uint64 : g1uint_min_type (uint64knd) = "mac#%"
fun g1uint_isgtz_uint64 : g1uint_isgtz_type (uint64knd) = "mac#%"
fun g1uint_iseqz_uint64 : g1uint_iseqz_type (uint64knd) = "mac#%"
fun g1uint_isneqz_uint64 : g1uint_isneqz_type (uint64knd) = "mac#%"
//
(* ****** ****** *)

(* end of [integer_fixed.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/unsafe.atxt
** Time of generation: Fri Aug 18 03:29:51 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: April, 2012 *)

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

#define
ATS_PACKNAME "ATSLIB.prelude.unsafe"

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

sortdef t0p = t@ype and vt0p = viewt@ype

(* ****** ****** *)
//
praxi
prop_assert{b:bool}((*void*)): [b] void
//
praxi
proof_assert{proof:prop}((*void*)): proof
//
praxi
eqint_assert{i1,i2:int}((*void*)): EQINT(i1,i2)
praxi
eqaddr_assert{l1,l2:addr}((*void*)): EQADDR(l1,l2)
praxi
eqbool_assert{b1,b2:bool}((*void*)): EQBOOL(b1,b2)
//
(* ****** ****** *)
//
castfn
cast{to:t0p}{from:t0p} (x: INV(from)):<> to
//
(* ****** ****** *)
//
castfn
castvwtp0
  {to:vt0p}{from:vt0p} (x: INV(from)):<> to
//
// HX:
// [castvwtp1] is mostly used in a situation
// where a linear value is passed as a read-only value;
// for instance, casting [strptr] to [string] is often
// done for treating a linear string as a nonlinear one
// temporarily.
//
castfn
castvwtp1
  {to:vt0p}{from:vt0p} (x: !INV(from)>>from):<> to
//
(* ****** ****** *)
//
castfn cast2ptr {a:type} (x: INV(a)):<> ptr
castfn cast2Ptr0 {a:type} (x: INV(a)):<> Ptr0
castfn cast2Ptr1 {a:type} (x: INV(a)):<> Ptr1
//
castfn cast2int {a:t0p} (x: INV(a)):<> int
castfn cast2uint {a:t0p} (x: INV(a)):<> uint
//
castfn cast2lint {a:t0p} (x: INV(a)):<> lint
castfn cast2ulint {a:t0p} (x: INV(a)):<> ulint
//
castfn cast2llint {a:t0p} (x: INV(a)):<> llint
castfn cast2ullint {a:t0p} (x: INV(a)):<> ullint
//
castfn cast2size {a:t0p} (x: INV(a)):<> size_t
castfn cast2ssize {a:t0p} (x: INV(a)):<> ssize_t
//
castfn cast2sint {a:t0p} (x: INV(a)):<> sint
castfn cast2usint {a:t0p} (x: INV(a)):<> usint
//
castfn cast2intptr {a:t0p} (x: INV(a)):<> intptr
castfn cast2uintptr {a:t0p} (x: INV(a)):<> uintptr
//
(* ****** ****** *)

praxi cast2void{a:vt0p}(x: INV(a)):<prf> void

(* ****** ****** *)
//
praxi castview0 {to:view}{from:view} (pf: from):<prf> to
praxi castview1 {to:view}{from:view} (pf: !INV(from)):<prf> to
//
(* ****** ****** *)
//
praxi
castview2void
  {to:view}{from:view}(x: !INV(from) >> to):<prf> void
praxi
castvwtp2void
  {to:vt0p}{from:vt0p}(x: !INV(from) >> to):<prf> void
//
praxi
castview2void_at
  {to:vt0p}{from:vt0p}{l:addr}(x: !INV(from@l) >> to@l):<prf> void
//
(* ****** ****** *)

fun{} int2ptr (i: int): ptr and ptr2int (p: ptr): int

(* ****** ****** *)
//
// HX: these are popular ones:
//
castfn list_vt2t
  {a:t0p}{n:int} (xs: !list_vt(INV(a), n)):<> list(a, n)
// end of [list_vt2t]

castfn arrayptr2ref
  {a:vt0p}{n:int} (x: !arrayptr (INV(a), n)):<> arrayref(a, n)
// end of [arrayptr2ref]

castfn strptr2string{l:agz}(x: !strptr(l)):<> String0
castfn strptr2stropt{l:addr}(x: !strptr(l)):<> Stropt0
castfn strnptr2string{l:addr}{n:nat}(x: !strnptr(l, n)):<> string(n)

(* ****** ****** *)
//
// HX: only if you know what you are doing ...
//
symintr ptr_vtake
//
castfn
ptr0_vtake
  {a:vt0p}
(
  p0: ptr
) :<> [l:addr] (a@l, a@l -<lin,prf> void | ptr(l))
castfn
ptr1_vtake
  {a:vt0p}{l:addr}
  (p0: ptr(l)):<> (a@l, a@l -<lin,prf> void | ptr(l))
//
overload ptr_vtake with ptr0_vtake of 0
overload ptr_vtake with ptr1_vtake of 10
//
(* ****** ****** *)

castfn
ref_vtake
{a:vt0p}
{l:addr}
(
  ref: ref(a)
) :<>
[
  l:addr
] (a@l, a@l -<lin,prf> void | ptr(l))
// end of [ref_vtake]

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

praxi
vtakeout_void{v:view}(pf: !v): vtakeout0(v)
castfn
vttakeout_void{a:vt0p}(x0: !a):<> vttakeout0(a)

(* ****** ****** *)
//
// HX: only if you know what you are doing ...
//
fun{a:vt0p} ptr0_get(p: ptr):<> (a)
fun{a:vt0p} ptr1_get(p: Ptr1):<> (a)
//
fun{a:vt0p} ptr0_set(p: ptr, x: INV(a)):<!wrt> void
fun{a:vt0p} ptr1_set(p: Ptr1, x: INV(a)):<!wrt> void
//
fun{a:vt0p} ptr0_exch(p: ptr, x: &INV(a) >> a):<!wrt> void
fun{a:vt0p} ptr1_exch(p: Ptr1, x: &INV(a) >> a):<!wrt> void
//
fun{a:vt0p} ptr0_intch(p1: ptr, p2: ptr):<!wrt> void
fun{a:vt0p} ptr1_intch(p1: Ptr1, p2: Ptr1):<!wrt> void
//
(* ****** ****** *)
//
fun{a:vt0p}
ptr0_getinc(p: &ptr >> _): (a)
fun{a:vt0p}
ptr1_getinc{l:addr}(p: &ptr(l) >> ptr(l+sizeof(a))): (a)
//
fun{a:vt0p}
ptr0_setinc(p: &ptr >> _, x: a): void
fun{a:vt0p}
ptr1_setinc{l:addr}(p: &ptr(l) >> ptr(l+sizeof(a)), x: a): void
//
(* ****** ****** *)
//
fun{a:vt0p}
ptr0_get_at_int(p: ptr, i: int):<> a
fun{a:vt0p}
ptr0_set_at_int(p: ptr, i: int, x: a):<!wrt> void
//
fun{a:vt0p}
ptr0_get_at_size(p: ptr, i: size_t):<> a
fun{a:vt0p}
ptr0_set_at_size(p: ptr, i: size_t, x: a):<!wrt> void
//
symintr ptr0_get_at
symintr ptr0_set_at
//
overload ptr0_get_at with ptr0_get_at_int
overload ptr0_set_at with ptr0_set_at_int
overload ptr0_get_at with ptr0_get_at_size
overload ptr0_set_at with ptr0_set_at_size
//
(* ****** ****** *)
//
// HX-2012-06:
// generic ops on numbers: +=, -=, *=, /=, %=
//
fun{a:t0p}
ptr0_addby(p: ptr, x: a):<!wrt> void // !p += x
fun{a:t0p}
ptr1_addby(p: Ptr1, x: a):<!wrt> void // !p += x
//
fun{a:t0p}
ptr0_subby(p: ptr, x: a):<!wrt> void // !p -= x
fun{a:t0p}
ptr1_subby(p: Ptr1, x: a):<!wrt> void // !p -= x
//
fun{a:t0p}
ptr0_mulby(p: ptr, x: a):<!wrt> void // !p *= x
fun{a:t0p}
ptr1_mulby(p: Ptr1, x: a):<!wrt> void // !p *= x
//
fun{a:t0p}
ptr0_divby(p: ptr, x: a):<!exnwrt> void // !p /= x
fun{a:t0p}
ptr1_divby(p: Ptr1, x: a):<!exnwrt> void // !p /= x
//
fun{a:t0p}
ptr0_modby(p: ptr, x: a):<!exnwrt> void // !p %= x
fun{a:t0p}
ptr1_modby(p: Ptr1, x: a):<!exnwrt> void // !p %= x
//
(* ****** ****** *)

fun
{a:vt0p}
ptr1_list_next(p: Ptr1): Ptr0 // HX: &(p->next)

(* ****** ****** *)
//
// HX: only if you know what you are doing ...
//
castfn
ptr2cptr{a:vt0p}{l:addr}(p: ptr(l)):<> cptr(a, l)
//
(* ****** ****** *)
//
castfn
cptr_vtake
  {a:vt0p}{l:agz}
(
  cp: cptr(INV(a), l)
) :<> (a@l, a@l -<lin,prf> void | ptr l)
// end of [cptr_vtake]
//
fun
{a:vt0p}
cptr_get(cp: cPtr1(INV(a))):<> a
fun
{a:vt0p}
cptr_set(cp: cPtr1(INV(a)), x: a):<!wrt> void
fun
{a:vt0p}
cptr_exch(cp: cPtr1(INV(a)), xr: &a >> a):<!wrt> void
//
(*
overload .get with cptr_get
overload .set with cptr_set
overload .exch with cptr_exch
*)
//
(* ****** ****** *)

(* end of [unsafe.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/checkast.atxt
** Time of generation: Fri Aug 18 03:29:52 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: gmhwxiATgmailDOTcom *)
(* Start time: December, 2013 *)

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

#define
ATS_PACKNAME "ATSLIB.prelude.checkast"

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

sortdef t0p = t@ype and vt0p = viewt@ype

(* ****** ****** *)
//
fun{}
checkast_charNZ
  (c: char, msg: RD(string)): charNZ
//
(* ****** ****** *)

fun{tk:tk}
checkast_gintLt{i:int}
  (x: g0int(tk), i: int i, msg: RD(string)): g1intLt(tk, i)
fun{tk:tk}
checkast_gintLte{i:int}
  (x: g0int(tk), i: int i, msg: RD(string)): g1intLte(tk, i)
fun{tk:tk}
checkast_gintGt{i:int}
  (x: g0int(tk), i: int i, msg: RD(string)): g1intGt(tk, i)
fun{tk:tk}
checkast_gintGte{i:int}
  (x: g0int(tk), i: int i, msg: RD(string)): g1intGte(tk, i)
fun{tk:tk}
checkast_gintBtw{i,j:int}
  (x: g0int(tk), i: int i, j: int j, msg: RD(string)): g1intBtw(tk, i, j)
fun{tk:tk}
checkast_gintBtwe{i,j:int}
  (x: g0int(tk), i: int i, j: int j, msg: RD(string)): g1intBtwe(tk, i, j)

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

macdef
ckastloc_charNZ(x) = checkast_charNZ(,(x), $mylocation)

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

macdef
ckastloc_gintLt(x, i) = checkast_gintLt(,(x), ,(i), $mylocation)
macdef
ckastloc_gintLte(x, i) = checkast_gintLte(,(x), ,(i), $mylocation)
macdef
ckastloc_gintGt(x, i) = checkast_gintGt(,(x), ,(i), $mylocation)
macdef
ckastloc_gintGte(x, i) = checkast_gintGte(,(x), ,(i), $mylocation)
macdef
ckastloc_gintBtw(x, i, j) = checkast_gintBtw(,(x), ,(i), ,(j), $mylocation)
macdef
ckastloc_gintBtwe(x, i, j) = checkast_gintBtwe(,(x), ,(i), ,(j), $mylocation)

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

fun{}
checkast_Ptr1(x: ptr, msg: RD(string)): Ptr1

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

macdef
ckastloc_Ptr1(x) = checkast_Ptr1(,(x), $mylocation)

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

fun{}
checkast_Strptr1(x: Strptr0, msg: RD(string)): Strptr1

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

macdef
ckastloc_Strptr1(x) = checkast_Strptr1(,(x), $mylocation)

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

(* end of [checkast.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/tuple.atxt
** Time of generation: Fri Aug 18 03:29:51 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: December, 2012 *)

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

sortdef t0p = t@ype and vt0p = viewt@ype

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

typedef SHR(a:type) = a // for commenting purpose
typedef NSH(a:type) = a // for commenting purpose

(* ****** ****** *)
//
typedef tup2
  (a0:t0p, a1:t0p) = @(a0, a1)
typedef tup3
  (a0:t0p, a1:t0p, a2:t0p) = @(a0, a1, a2)
typedef tup4
  (a0:t0p, a1:t0p, a2:t0p, a3:t0p) = @(a0, a1, a2, a3)
//
stadef tup = tup2
stadef tup = tup3
stadef tup = tup4
//
(* ****** ****** *)
//
typedef tupbox1
  (a0:t0p) = $tup(a0)
typedef tupbox2
  (a0:t0p, a1:t0p) = $tup(a0, a1)
typedef tupbox3
  (a0:t0p, a1:t0p, a2:t0p) = $tup(a0, a1, a2)
typedef tupbox4
  (a0:t0p, a1:t0p, a2:t0p, a3:t0p) = $tup(a0, a1, a2, a3)
//
stadef tupbox = tupbox1
stadef tupbox = tupbox2
stadef tupbox = tupbox3
stadef tupbox = tupbox4
//
(* ****** ****** *)

fun{} fprint_tup$beg (out: FILEref): void
fun{} fprint_tup$end (out: FILEref): void
fun{} fprint_tup$sep (out: FILEref): void

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

fun{
a0,a1:t0p
} fprint_tupval2 (out: FILEref, x: @(a0, a1)): void
fun{
a0,a1,a2:t0p
} fprint_tupval3 (out: FILEref, x: @(a0, a1, a2)): void
fun{
a0,a1,a2,a3:t0p
} fprint_tupval4 (out: FILEref, x: @(a0, a1, a2, a3)): void

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

fun{
a0,a1:vt0p
} fprint_tupref2 (out: FILEref, x: &(a0, a1)): void
fun{
a0,a1,a2:vt0p
} fprint_tupref3 (out: FILEref, x: &(a0, a1, a2)): void
fun{
a0,a1,a2,a3:vt0p
} fprint_tupref4 (out: FILEref, x: &(a0, a1, a2, a3)): void

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

fun{} fprint_tupbox$beg (out: FILEref): void
fun{} fprint_tupbox$end (out: FILEref): void
fun{} fprint_tupbox$sep (out: FILEref): void

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

fun{
a0:t0p
} fprint_tupbox1 (out: FILEref, x: $tup(a0)): void
fun{
a0,a1:t0p
} fprint_tupbox2 (out: FILEref, x: $tup(a0, a1)): void
fun{
a0,a1,a2:t0p
} fprint_tupbox3 (out: FILEref, x: $tup(a0, a1, a2)): void
fun{
a0,a1,a2,a3:t0p
} fprint_tupbox4 (out: FILEref, x: $tup(a0, a1, a2, a3)): void

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

fun{
a0,a1:t0p
} tupval2_equal
  (x: @(a0, a1), y: @(a0, a1)):<> bool
// end of [tupval2_equal]

fun{
a0,a1,a2:t0p
} tupval3_equal
  (x: @(a0, a1, a2), y: @(a0, a1, a2)):<> bool
// end of [tupval3_equal]

fun{
a0,a1,a2,a3:t0p
} tupval4_equal
  (x: @(a0, a1, a2, a3), y: @(a0, a1, a2, a3)):<> bool
// end of [tupval4_equal]

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

fun{
a0,a1:vt0p
} tupref2_equal
  (x: &(a0, a1), y: &(a0, a1)):<> bool
// end of [tupref2_equal]

fun{
a0,a1,a2:vt0p
} tupref3_equal
  (x: &(a0, a1, a2), y: &(a0, a1, a2)):<> bool
// end of [tupref3_equal]

fun{
a0,a1,a2,a3:vt0p
} tupref4_equal
  (x: &(a0, a1, a2, a3), y: &(a0, a1, a2, a3)):<> bool
// end of [tupref4_equal]

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

fun{
a0,a1:t0p
} tupval2_compare
  (x: @(a0, a1), y: @(a0, a1)):<> int
// end of [tupval2_compare]

fun{
a0,a1,a2:t0p
} tupval3_compare
  (x: @(a0, a1, a2), y: @(a0, a1, a2)):<> int
// end of [tupval3_compare]

fun{
a0,a1,a2,a3:t0p
} tupval4_compare
  (x: @(a0, a1, a2, a3), y: @(a0, a1, a2, a3)):<> int
// end of [tupval4_compare]

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

fun{
a0,a1:vt0p
} tupref2_compare
  (x: &(a0, a1), y: &(a0, a1)):<> int
// end of [tupref2_compare]

fun{
a0,a1,a2:vt0p
} tupref3_compare
  (x: &(a0, a1, a2), y: &(a0, a1, a2)):<> int
// end of [tupref3_compare]

fun{
a0,a1,a2,a3:vt0p
} tupref4_compare
  (x: &(a0, a1, a2, a3), y: &(a0, a1, a2, a3)):<> int
// end of [tupref4_compare]

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

(* end of [tuple.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/reference.atxt
** Time of generation: Fri Aug 18 03:29:51 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: March, 2012 *)

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

sortdef t0p = t@ype and vt0p = viewt@ype

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

castfn ref_get_ptr
  {a:vt0p} (r: ref a):<> [l:agz] ptr (l)
castfn ref_get_viewptr
  {a:vt0p} (r: ref a):<> [l:agz] (vbox (a @ l) | ptr l)
// end of [ref_get_viewptr]

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

(*
macdef ptr_of_ref = ref_get_ptr
*)

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

fun{a:vt0p} ref(x: a):<!wrt> ref(a)
fun{a:vt0p} ref_make_elt(x: a):<!wrt> ref(a)

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

castfn
ref_make_viewptr
  {a:vt0p}{l:addr} (pf: a @ l | p: ptr l):<> ref(a)
// end of [ref_make_viewptr]

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

fun{a:vt0p}
ref_make_type_elt(TYPE(a), a):<!wrt> ref(a)

(* ****** ****** *)
//
fun{a:t0p} ref_get_elt (r: ref a):<!ref> a
fun{a:t0p} ref_set_elt (r: ref a, x: a):<!refwrt> void
//
(* ****** ****** *)
//
fun{a:vt0p} ref_exch_elt (r: ref a, x: &a>>a):<!refwrt> void
//
(* ****** ****** *)

(*
** HX-2012-05:
** this is not particularly useful except for the purpose
** of avoiding using the [vbox] pattern
*)

fun{}
ref_app_fun{a:vt0p}
(
  r: ref a, f: (&(a)>>_) -<0,!wrt> void
) :<!refwrt> void // end of [ref_app_fun]

fun{}
ref_app_funenv{a:vt0p}
  {v:view}{vt:viewtype}
(
  pfv: !v
| r: ref a, f: (!v | &(a)>>_, !vt) -<0,!wrt> void, env: !vt
) :<!refwrt> void // end of [ref_app_funenv]

(* ****** ****** *)
//
// HX-2013-10: unsafe but convenient
//
fun{}
ref_vtakeout
  {a:vt0p}
(
  ref: ref (a)
) :<!ref> [l:addr] (a @ l, (a @ l) -<lin,prf> void | ptr(l))
//
(* ****** ****** *)
//
// overloading for certain symbols
//
(* ****** ****** *)

overload [] with ref_get_elt // ref[]
overload [] with ref_set_elt // ref[] := (val)

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

(* end of [reference.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/filebas.atxt
** Time of generation: Fri Aug 18 03:29:52 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: February, 2012 *)

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

sortdef t0p = t@ype and vt0p = viewt@ype

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

#define NSH (x) x // for commenting: no sharing
#define SHR (x) x // for commenting: it is shared

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

val stdin_ref : FILEref = "mac#%FILE_stdin"
val stdout_ref : FILEref = "mac#%FILE_stdout"
val stderr_ref : FILEref = "mac#%FILE_stderr"

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

fun{} dirsep_get ():<> charNZ
fun{} dirname_self ():<> string
fun{} dirname_parent ():<> string

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

fun{}
filename_get_ext(name: string):<> vStrptr0
fun{}
filename_test_ext(name: string, ext: string):<> bool

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

fun{}
filename_get_base (name: string):<> vStrptr1
fun{}
filename_test_base (name: string, base: string):<> bool

(* ****** ****** *)
//
val file_mode_r
  : file_mode(file_mode_r()) = "mac#%" // = "r"
val file_mode_rr
  : file_mode(file_mode_rw()) = "mac#%" // = "r+"
//
val file_mode_w
  : file_mode(file_mode_w()) = "mac#%" // = "w"
val file_mode_ww
  : file_mode(file_mode_rw()) = "mac#%" // = "w+"
//
val file_mode_a
  : file_mode(file_mode_rw()) = "mac#%" // = "a"
val file_mode_aa
  : file_mode(file_mode_rw()) = "mac#%" // = "a+"
//
(* ****** ****** *)
//
(*
** HX: [stat] is called
*)
fun
test_file_exists
  (path: NSH(string)): bool = "mac#%"
//
(* ****** ****** *)
//
// HX-2011-02-16:
// [stat] is called to obtain the mode of a given file
// for [f] to be applied to it.
//
fun{}
test_file_mode
  (path: NSH(string)): int
//
fun{}
test_file_mode$pred (mode: uint): bool
//
fun
test_file_mode_fun
  (path: NSH(string), f: uint -> bool): int = "mac#%"
//
// HX: [stat] is called // ~1/0/1: error/false/true
//
fun
test_file_isblk(path: NSH(string)): int = "mac#%"
fun
test_file_ischr(path: NSH(string)): int = "mac#%"
fun
test_file_isdir(path: NSH(string)): int = "mac#%"
fun
test_file_isfifo(path: NSH(string)): int = "mac#%"
fun
test_file_isreg(path: NSH(string)): int = "mac#%"
//
// HX: [lstat] is called // ~1/0/1: error/false/true
//
fun
test_file_islnk(path: NSH(string)): int = "mac#%"
//
(* ****** ****** *)
//
fun
fileref_open_exn
  (path: NSH(string), file_mode): FILEref = "mac#%"
// end of [fileref_open_exn]
//
fun{}
fileref_open_opt
  (path: NSH(string), file_mode): Option_vt(FILEref)
// end of [fileref_open_opt]
//
(* ****** ****** *)
//
fun
fileref_close(fil: FILEref): void = "mac#%"
//
(* ****** ****** *)
//
fun
fileref_flush(fil: FILEref): void = "mac#%"
//
(* ****** ****** *)
//
// HX: error indication: EOF
//
fun
fileref_getc(input: FILEref): int = "mac#%"
//
(* ****** ****** *)
//
// HX: no error reporting
//
fun
fileref_putc_int
  (out: FILEref, c: int): void = "mac#%"
//
fun
fileref_putc_char
  (out: FILEref, c: char): void = "mac#%"
//
symintr fileref_putc
overload fileref_putc with fileref_putc_int
overload fileref_putc with fileref_putc_char
//
(* ****** ****** *)
//
// HX: no error reporting
//
fun
fileref_puts
  (out: FILEref, NSH(string)): void = "mac#%"
//
(* ****** ****** *)
//
fun
fileref_is_eof(inp: FILEref): bool = "mac#%"
//
macdef
fileref_isnot_eof(inp) = ~fileref_is_eof(,(inp))
//
(* ****** ****** *)

typedef
fileref_load_type(a:t@ype) =
  (FILEref, &a? >> opt(a, b)) -<fun1> #[b:bool] bool(b)
// end of [fileref_load_type]
//
fun{a:t0p}
fileref_load : fileref_load_type (a)
//
fun
fileref_load_int : fileref_load_type(int) = "mac#%"
fun
fileref_load_lint : fileref_load_type(lint) = "mac#%"
fun
fileref_load_uint : fileref_load_type(uint) = "mac#%"
fun
fileref_load_ulint : fileref_load_type(ulint) = "mac#%"
//
fun
fileref_load_float : fileref_load_type(float) = "mac#%"
fun
fileref_load_double : fileref_load_type(double) = "mac#%"
//
(* ****** ****** *)

fun{a:t0p}
fileref_get_optval
  (inp: FILEref): Option_vt(a)
// end of [fileref_get_optval]

fun{
a:t0p
} fileref_get_exnmsg
  (inp: FILEref, msg: NSH(string)): a
// end of [fileref_get_exnmsg]

macdef
fileref_get_exnloc
  (inp) = fileref_get_exnmsg(,(inp), $mylocation)
// end of [fileref_get_exnloc]

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

typedef charlst = List0(char)
vtypedef charlst_vt = List0_vt(char)

(* ****** ****** *)
//
fun
fileref_get_line_charlst(inp: FILEref): charlst_vt
//
(* ****** ****** *)
//
(*
** HX: only for files of "tiny" size
*)
fun
fileref_get_lines_charlstlst(inp: FILEref): List0_vt(charlst_vt)
//
(* ****** ****** *)
//
(*
** HX: for handling files of "tiny" size
*)
fun
fileref_get_file_charlst(inp: FILEref): List0_vt(char)
fun
fileref_get2_file_charlst(inp: FILEref, n: int): List0_vt(char)
//
(* ****** ****** *)
//
fun
fileref_put_charlst(inp: FILEref, cs: NSH(List(char))): void
//
(* ****** ****** *)
//
//
// HX-2013-05:
// these functions are based on [fgets];
// they should only be applied to files containing
// no occurrences of the NUL character ('\000').
//
fun{}
fileref_get_line_string(inp: FILEref): Strptr1
//
fun{}
fileref_get_line_string_main
(
  inp: FILEref, nchar: &int? >> int(n)
) : #[n:nat] strnptr(n) // end-of-function
fun{}
fileref_get_line_string$bufsize((*void*)): intGte(1)
//
fun{}
fileref_get_lines_stringlst(inp: FILEref): List0_vt(Strptr1)
//
(* ****** ****** *)
//
fun{}
fileref_get_file_string(inp: FILEref): Strptr1
fun{}
fileref_get_file_string$bufsize((*void*)): intGte(1)
//
(* ****** ****** *)
//
fun{}
fileref_get_word(inp: FILEref): Strptr0
fun{}
fileref_get_word$isalpha(c0: charNZ): bool
//
(* ****** ****** *)
//
fun{}
fileref_foreach(inp: FILEref): void
fun{
env:vt0p
} fileref_foreach_env(inp: FILEref, env: &(env) >> _): void
//
fun{}
fileref_foreach$bufsize((*void*)): sizeGte(1)
fun{
env:vt0p
} fileref_foreach$fwork(c: char, env: &(env) >> _): void
fun{
env:vt0p
} fileref_foreach$fworkv
  {n:int} (arrayref(char, n), size_t(n), &(env) >> _): void
//
(* ****** ****** *)
//
fun{}
streamize_fileref_char(inp: FILEref): stream_vt(char)
fun{}
streamize_fileref_line(inp: FILEref): stream_vt(Strptr1)
//
(* ****** ****** *)
//
absvtype FILEptr1_vtype = ptr
vtypedef FILEptr1 = FILEptr1_vtype
//
(*
fun{}
streamize_fileptr_char(inp: FILEptr1): stream_vt(char)
*)
fun{}
streamize_fileptr_line(inp: FILEptr1): stream_vt(Strptr1)
//
(* ****** ****** *)

(* end of [filebas.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)
(* ****** ****** *)

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: June, 2012 *)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/intrange.atxt
** Time of generation: Fri Aug 18 03:29:52 2017
*)

(* ****** ****** *)
//
// HX-2013-04:
// intrange (l, r) is for integers i satisfying l <= i < r
//
(* ****** ****** *)
//
fun{}
intrange_foreach (l: int, r: int): int
fun{env:vt0p}
intrange_foreach_env (l: int, r: int, env: &(env) >> _): int
//
fun{env:vt0p}
intrange_foreach$cont (i: int, env: &env): bool
fun{env:vt0p}
intrange_foreach$fwork (i: int, env: &(env) >> _): void
//
(* ****** ****** *)

fun{}
int_foreach_cloref
(
  n: int, fwork: (int) -<cloref1> void
) : int // end of [int_foreach_cloref]
fun{}
intrange_foreach_cloref
(
  l: int, r: int, fwork: (int) -<cloref1> void
) : int // end of [intrange_foreach_cloref]

(* ****** ****** *)
//
fun{}
intrange_rforeach (l: int, r: int): int
fun{env:vt0p}
intrange_rforeach_env (l: int, r: int, env: &(env) >> _): int
//
fun{env:vt0p}
intrange_rforeach$cont (i: int, env: &env): bool
fun{env:vt0p}
intrange_rforeach$fwork (i: int, env: &(env) >> _): void
//
(* ****** ****** *)

fun{}
int_rforeach_cloref
(
  n: int, fwork: (int) -<cloref1> void
) : int // end of [int_rforeach_cloref]
fun{}
intrange_rforeach_cloref
(
  l: int, r: int, fwork: (int) -<cloref1> void
) : int // end of [intrange_rforeach_cloref]

(* ****** ****** *)
//
fun{}
intrange2_foreach
  (l1: int, r1: int, l2: int, r2: int): void
//
fun{env:vt0p}
intrange2_foreach_env
  (l1: int, r1: int, l2: int, r2: int, env: &(env) >> _): void
//
fun{env:vt0p}
intrange2_foreach$fwork (i: int, j: int, env: &env >> _): void
//
(* ****** ****** *)
//
fun{}
streamize_intrange_l(m: int): stream_vt(int)
fun{}
streamize_intrange_lr(m: int, n: int): stream_vt(int)
//
(* ****** ****** *)

(* end of [intrange.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(* Author: Hongwei Xi *)
(* Start time: February, 2012 *)
(* Authoremail: gmhwxiATgmailDOTcom *)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/list.atxt
** Time of generation: Fri Aug 18 03:29:53 2017
*)

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

#define NSH (x) x // for commenting: no sharing
#define SHR (x) x // for commenting: it is shared

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

#if(0)
//
// HX:
// these declarations
// are available in [basic_dyn.sats]
//
datatype
list_t0ype_int_type
  (a:t@ype+, int) =
//
// t@ype+: covariant
//
  | list_nil(a, 0) of ((*void*))
  | {n:int | n >= 0}
    list_cons(a, n+1) of (a, list_t0ype_int_type(a, n))
// end of [list_t0ype_int_type]
//
stadef
list = list_t0ype_int_type
//
typedef
List(a:t0p) = [n:int] list(a, n)
typedef
List0(a:t0p) = [n:int | n >= 0] list(a, n)
typedef
List1(a:t0p) = [n:int | n >= 1] list(a, n)
typedef listLt
  (a:t0p, n:int) = [k:nat | k < n] list(a, k)
typedef listLte
  (a:t0p, n:int) = [k:nat | k <= n] list(a, k)
typedef listGt
  (a:t0p, n:int) = [k:int | k > n] list(a, k)
typedef listGte
  (a:t0p, n:int) = [k:int | k >= n] list(a, k)
typedef listBtw
  (a:t0p, m:int, n:int) = [k:int | m <= k; k < n] list(a, k)
typedef listBtwe
  (a:t0p, m:int, n:int) = [k:int | m <= k; k <= n] list(a, k)
//
#endif

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

#define nil list_nil
#define cons list_cons

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

exception
ListSubscriptExn of ()
(*
//
fun
ListSubscriptExn():<> exn = "mac#%ListSubscriptExn_make"
fun
isListSubscriptExn(x: !exn):<> bool = "mac#%isListSubscriptExn"
//
macdef
ifListSubscriptExn
  {tres}(exn, body) =
(
let val x = ,(exn) in
(
if isListSubscriptExn(x)
  then
    let prval () = __vfree_exn (x) in ,(body) end
  else $raise (x)
) : tres // end of [if]
end (* end of [let] *)
) // end of [ifListSubscriptExn]
*)

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

prfun
lemma_list_param
  {x:t0p}{n:int}
  (xs: list(INV(x), n)): [n >= 0] void
// end of [lemma_list_param]

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

castfn
list_cast
  {x:t0p}{n:int}
  (xs: list(INV(x), n)):<> list(x, n)
// end of [list_cast]

(* ****** ****** *)
//
castfn
list_vt2t
  {x:t0p}{n:int}
  (xs: list_vt(INV(x), n)):<> list(x, n)
castfn
list_of_list_vt
  {x:t0p}{n:int}
  (xs: list_vt(INV(x), n)):<!wrt> list(x, n)
//
(* ****** ****** *)

#define list_sing(x)
  list_cons(x, list_nil())
#define list_pair(x1, x2)
  list_cons(x1, list_cons(x2, list_nil()))

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

fun{x:t0p}
list_make_sing (x: x):<!wrt> list_vt(x, 1)
fun{x:t0p}
list_make_pair (x1: x, x2: x):<!wrt> list_vt(x, 2)

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

fun{x:t0p}
list_make_elt
  {n:nat} (n: int n, x: x):<!wrt> list_vt(x, n)
// end of [list_make_elt]

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

fun{
} list_make_intrange
  {l,r:int | l <= r}
  (l: int l, r: int r):<!wrt> list_vt(intBtw(l, r), r-l)
// end of [list_make_intrange]

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

fun
{a:vt0p}
list_make_array
  {n:int} (
  A: &(@[INV(a)][n]) >> @[a?!][n], n: size_t(n)
) :<!wrt> list_vt(a, n) // endfun

(* ****** ****** *)
//
symintr list
//
fun
{a:vt0p}
list_make_arrpsz
  {n:int}
  (psz: arrpsz(INV(a), n)):<!wrt> list_vt(a, n)
//
overload list with list_make_arrpsz
//
(* ****** ****** *)
//
fun{x:t0p}
print_list(xs: List(INV(x))): void
fun{x:t0p}
prerr_list(xs: List(INV(x))): void
//
fun{x:t0p}
fprint_list(out: FILEref, xs: List(INV(x))): void
fun{x:t0p}
fprint_list_sep
  (out: FILEref, xs: List(INV(x)), sep: string): void
// end of [fprint_list_sep]
//
fun{}
fprint_list$sep (out: FILEref): void
//
(* ****** ****** *)

fun{x:t0p}
fprint_listlist_sep
( out: FILEref
, xss: List(List(INV(x))), sep1: string, sep2: string
) : void // end of [fprint_listlist_sep]

(* ****** ****** *)
(*
//
// HX: for testing macdef
//
*)
//
(*
//
macdef
fprintlst_mac
  {T:t@ype}
  (fpr, out, xs0, sep) = let
//
val out = ,(out)
val xs0 = ,(xs0); val sep = ,(sep)
//
fun
loop (
xs: List(T), i: int
) : void =
  case+ xs of
  | list_nil
      () => ((*void*))
    // list_nil
  | list_cons
      (x, xs) => let
      val () =
      if i > 0
        then fprint_string(out, sep)
      // end of [if]
      val () = ,(fpr)(out, x)
    in
      loop (xs, i+1)
    end // end of [list_cons]
//
in
  loop(xs0, 0)
end // end of [fprintlst_mac]
*)
//
(* ****** ****** *)
//
fun{}
list_is_nil
  {x:t0p}{n:int}(xs: list(x, n)):<> bool(n==0)
fun{}
list_is_cons
  {x:t0p}{n:int}(xs: list(x, n)):<> bool(n > 0)
//
fun{x:t0p}
list_is_sing{n:int}(xs: list(INV(x), n)):<> bool(n==1)
fun{x:t0p}
list_is_pair{n:int}(xs: list(INV(x), n)):<> bool(n==2)
//
(* ****** ****** *)

fun{x:t0p}
list_head{n:pos}(xs: list(INV(x), n)):<> (x)
fun{x:t0p}
list_head_exn{n:int}(xs: list(INV(x), n)):<!exn> (x)

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

fun{x:t0p}
list_tail{n:pos}
  (xs: SHR(list(INV(x), n))):<> list(x, n-1)
fun{x:t0p}
list_tail_exn{n:int}
  (xs: SHR(list(INV(x), n))):<!exn> list(x, n-1)

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

fun{x:t0p}
list_last{n:pos} (xs: list(INV(x), n)):<> (x)
fun{x:t0p}
list_last_exn{n:int} (xs: list(INV(x), n)):<!exn> (x)

(* ****** ****** *)
//
fun{
x:t0p
} list_nth{n:int}
  (list(INV(x), n), natLt(n)):<> (x)
fun{x:t0p}
list_nth_opt
  (xs: List(INV(x)), i: intGte(0)):<> Option_vt(x)
//
fun{x:t0p}
list_get_at{n:int}
  (list(INV(x), n), natLt(n)):<> (x)
fun{x:t0p}
list_get_at_opt
  (xs: List(INV(x)), i: intGte(0)):<> Option_vt(x)
//
(* ****** ****** *)
//
fun{x:t0p}
list_fset_at{n:nat}
  (list(INV(x), n), natLt(n), x):<> list(x, n)
fun{x:t0p}
list_fexch_at{n:nat}
  (list(INV(x), n), natLt(n), x):<> (list(x, n), x)
//
(* ****** ****** *)

fun{x:t0p}
list_insert_at
  {n:int}
(
xs: SHR(list(INV(x), n)), i: natLte(n), x: x
) :<> list(x, n+1) // end of [list_insert_at]

fun{x:t0p}
list_remove_at
  {n:int} (
  xs: SHR(list(INV(x), n)), i: natLt(n)
) :<> list(x, n-1) // end of [list_remove_at]

fun{x:t0p}
list_takeout_at
  {n:int} (
  xs: SHR(list(INV(x), n)), i: natLt(n), x: &(x)? >> x
) :<!wrt> list(x, n-1) // end of [list_takeout_at]

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

fun{x:t0p}
list_length
  {n:int} (xs: list(INV(x), n)):<> int(n)
// end of [list_length]

(* ****** ****** *)
//
fun{x:t0p}
list_length_gte
  {n1,n2:int}
  (xs: list(INV(x), n1), n2: int(n2)): bool(n1 >= n2)
fun{x:t0p}
list_length_compare
  {n1,n2:int}
  (xs: list(INV(x), n1), n2: int(n2)): int(sgn(n1-n2))
//
overload >= with list_length_gte
overload compare with list_length_compare
//
(* ****** ****** *)

fun
{x:t0p}
list_copy
  {n:int}
  (xs: list(INV(x), n)):<!wrt> list_vt(x, n)
// end of [list_copy]

(* ****** ****** *)
//
fun
{a:t0p}
list_append
  {m,n:int}
(
xs: NSH(list(INV(a), m)), ys: SHR(list(a, n))
) :<> list(a, m+n) // end of [list_append]
//
(* ****** ****** *)

fun
{a:t0p}
list_append1_vt
  {i,j:int} (
  xs: list_vt(INV(a), i), ys: SHR(list(a, j))
) :<!wrt> list(a, i+j) // endfun
fun
{a:t0p}
list_append2_vt
  {i,j:int} (
  xs: NSH(list(INV(a), i)), ys: list_vt(a, j)
) :<!wrt> list_vt(a, i+j) // endfun

(* ****** ****** *)
//
fun{
x:t0p
} list_extend{n:int}
  (xs: list(INV(x), n), x: x):<!wrt> list_vt(x, n+1)
// end of [list_extend]
//
macdef list_snoc (xs, x) = list_extend (,(xs), ,(x))
//
(* ****** ****** *)
//
fun
{a:t0p}
mul_int_list
  {m,n:int | m >= 0}
  (m: int(m), xs: list(a, n)):<!wrt> list_vt(a, m*n)
//
(* ****** ****** *)

fun{x:t0p}
list_reverse
  {n:int} (xs: list(INV(x), n)):<!wrt> list_vt(x, n)
// end of [list_reverse]

(* ****** ****** *)
//
fun{a:t0p}
list_reverse_append
  {m,n:int}
  (xs: NSH(list(INV(a), m)), ys: SHR(list(a, n))):<> list(a, m+n)
// end of [list_reverse_append]
//
fun{a:t0p}
list_reverse_append1_vt
  {m,n:int}
  (xs: list_vt(INV(a), m), ys: SHR(list(a, n))):<!wrt> list(a, m+n)
// end of [list_reverse_append1_vt]
fun{a:t0p}
list_reverse_append2_vt
  {m,n:int}
  (xs: NSH(list(INV(a), m)), ys: list_vt(a, n)):<!wrt> list_vt(a, m+n)
// end of [list_reverse_append2_vt]
//
macdef list_revapp = list_reverse_append
macdef list_revapp1_vt = list_reverse_append1_vt
macdef list_revapp2_vt = list_reverse_append2_vt
//
(* ****** ****** *)

fun{x:t0p}
list_concat(xss: List(List(INV(x)))):<!wrt> List0_vt(x)

(* ****** ****** *)
//
fun{
x:t0p
} list_take
  {n:int}{i:nat | i <= n}
  (xs: list(INV(x), n), i: int i):<!wrt> list_vt(x, i)
fun{
x:t0p
} list_take_exn
  {n:int}{i:nat} // it may raise [ListSubscriptException]
  (xs: list(INV(x), n), i: int i):<!exnwrt> [i <= n] list_vt(x, i)
//
(* ****** ****** *)
//
fun{
x:t0p
} list_drop
  {n:int}{i:nat | i <= n}
  (xs: SHR(list(INV(x), n)), i: int i):<> list(x, n-i)
fun{
x:t0p
} list_drop_exn
  {n:int}{i:nat} // it may raise [ListSubscriptException]
  (xs: SHR(list(INV(x), n)), i: int i):<!exn> [i <= n] list(x, n-i)
//
(* ****** ****** *)

fun{
x:t0p
} list_split_at
  {n:int}{i:nat | i <= n}
  (xs: SHR(list(INV(x), n)), i: int i):<!wrt> (list_vt(x, i), list(x, n-i))
// end of [list_split_at]

(* ****** ****** *)
//
fun{x:t0p}
list_exists$pred(x: x):<> bool
fun{x:t0p}
list_exists(xs: List(INV(x))):<> bool
//
fun{x:t0p}
list_exists_cloref
  (xs: List(INV(x)), pred: (x) -<cloref> bool):<> bool
fun{x:t0p}
list_iexists_cloref
  {n:int}
(
  xs: list(INV(x), n), pred: (natLt(n), x) -<cloref> bool
) :<> bool // end of [list_iexists_cloref]
//
(* ****** ****** *)
//
fun{x:t0p}
list_forall$pred(x: x):<> bool
fun{x:t0p}
list_forall(xs: List(INV(x))):<> bool
//
fun{x:t0p}
list_forall_cloref
  (xs: List(INV(x)), pred: (x) -<cloref> bool):<> bool
fun{x:t0p}
list_iforall_cloref
  {n:int}
(
  xs: list(INV(x), n), pred: (natLt(n), x) -<cloref> bool
) :<> bool // end of [list_iforall_cloref]
//
(* ****** ****** *)
//
fun{x:t0p}
list_equal$eqfn(x1: x, x2: x):<> bool
fun{x:t0p}
list_equal(xs1: List(INV(x)), xs2: List(x)):<> bool
fun{x:t0p}
list_equal_cloref
  (List(INV(x)), List(x), eqfn: (x, x) -<cloref> bool):<> bool
//
(* ****** ****** *)
//
fun{
x:t0p
} list_find{n:int}
(
  xs: list(INV(x), n), x0: &(x)? >> opt(x, i >= 0)
) :<!wrt> #[i:int | i < n] int(i) // end-of-function
//
fun{x:t0p} list_find$pred (x):<> bool
//
fun{x:t0p} list_find_exn (xs: List(INV(x))):<!exn> x
fun{x:t0p} list_find_opt (xs: List(INV(x))):<> Option_vt(x)
//
(* ****** ****** *)
//
fun{
key,itm:t0p
} list_assoc
(
  List@(INV(key), itm), key, x: &itm? >> opt(itm, b)
) :<> #[b:bool] bool(b) // end of [list_assoc]
//
fun{key:t0p}
list_assoc$eqfn (k1: key, k2: key):<> bool
//
fun{
key,itm:t0p
} list_assoc_exn
  (kxs: List @(INV(key), itm), k: key):<!exn> itm
fun{
key,itm:t0p
} list_assoc_opt
  (kxs: List @(INV(key), itm), k: key):<> Option_vt(itm)
//
(* ****** ****** *)
//
fun{
x:t0p
} list_filter{n:int}
  (xs: list(INV(x), n)): listLte_vt(x, n)
//
fun{x:t0p} list_filter$pred (x): bool
//
(*
fun{
x:t0p
} list_filter_funenv
  {v:view}{vt:viewtype}{n:int}{fe:eff}
(
  pfv: !v |
  xs: list(INV(x), n)
, f: (!v | x, !vt) -<fun,fe> bool, env: !vt
) :<fe,!wrt> listLte_vt(x, n) // end-of-function
*)
//
(* ****** ****** *)

fun{
x:t0p
} list_labelize{n:int}
  (xs: list(INV(x), n)):<!wrt> list_vt(@(int, x), n)
// end of [list_labelize]

(* ****** ****** *)
//
fun{x:t0p}
list_app (xs: List(INV(x))): void
//
fun{x:t0p} list_app$fwork (x): void
//
(* ****** ****** *)
//
fun{x:t0p}
list_app_fun
  (xs: List(INV(x)), fwork: (x) -<fun1> void): void
fun{x:t0p}
list_app_clo
  (xs: List(INV(x)), fwork: (x) -<clo1> void): void
fun{x:t0p}
list_app_cloref
  (xs: List(INV(x)), fwork: (x) -<cloref1> void): void
//
(* ****** ****** *)
//
(*
fun{
x:t0p
} list_app_funenv
  {v:view}{vt:viewtype}{n:int}{fe:eff} (
  pfv: !v |
  xs: list(INV(x), n)
, f: (!v | x, !vt) -<fun,fe> void, env: !vt
) :<fe> void // end of [list_app_funenv]
*)
//
(* ****** ****** *)
//
fun{
x:t0p}{y:vt0p
} list_map{n:int}
  (xs: list(INV(x), n)): list_vt(y, n)
// end of [list_map]
//
fun{x:t0p}{y:vt0p} list_map$fopr(x: x): (y)
//
(* ****** ****** *)

fun{
x:t0p}{y:vt0p
} list_map_fun{n:int}
  (xs: list(INV(x), n), f: (x) -<fun1> y): list_vt(y, n)

fun{
x:t0p}{y:vt0p
} list_map_clo{n:int}
  (xs: list(INV(x), n), f: &(x) -<clo1> y): list_vt(y, n)

fun{
x:t0p}{y:vt0p
} list_map_cloref{n:int}
  (xs: list(INV(x), n), f: (x) -<cloref1> y): list_vt(y, n)

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

(*
fun{
x:t0p}{y:vt0p
} list_map_funenv
  {v:view}{vt:viewtype}{n:int}{fe:eff} (
  pfv: !v |
  xs: list(INV(x), n)
, f: (!v | x, !vt) -<fun,fe> y, env: !vt
) :<fe,!wrt> list_vt(y, n) // end of [list_map_funenv]
*)

(* ****** ****** *)
//
fun
{x:t0p}
{y:vt0p}
list_imap{n:int}
  (xs: list(INV(x), n)): list_vt(y, n)
//
fun
{x:t0p}
{y:vt0p}
list_imap$fopr(i: intGte(0), x: x): (y)
//
(* ****** ****** *)
//
fun
{x:t0p}
{y:vt0p}
list_mapopt{n:int}
  (xs: list(INV(x), n)): listLte_vt(y, n)
//
fun
{x:t0p}
{y:vt0p}
list_mapopt$fopr(x: x): Option_vt(y)
//
(*
fun{
x:t0p}{y:t0p
} list_mapopt_funenv
  {v:view}{vt:viewtype}{n:int}{fe:eff}
(
  pfv: !v |
  xs: list(INV(x), n)
, f: (!v | x, !vt) -<fun,fe> Option_vt(y), env: !vt
) :<fe> listLte_vt(y, n) // end of [list_mapopt_funenv]
*)
//
(* ****** ****** *)

fun{
x1,x2:t0p}{y:vt0p
} list_map2{n1,n2:int}
(
  xs1: list(INV(x1), n1)
, xs2: list(INV(x2), n2)
) : list_vt(y, min(n1,n2)) // end of [list_map2]
//
fun{
x1,x2:t0p}{y:vt0p
} list_map2$fopr (x1: x1, x2: x2): (y)
//
(*
fun{
x1,x2:t0p}{y:t0p
} list_map2_funenv
  {v:view}{vt:viewtype}{n1,n2:int}{fe:eff}
(
  pfv: !v |
  xs1: list(INV(x1), n1)
, xs2: list(INV(x2), n2)
, f: (!v | x1, x2, !vt) -<fun,fe> y, env: !vt
) :<fe> list_vt(y, min(n1,n2)) // end of [list_map2_funenv]
*)
//
(* ****** ****** *)
//
fun{
a:vt0p
} list_tabulate{n:nat} (int n): list_vt(a, n)
//
fun{a:vt0p} list_tabulate$fopr (index: intGte(0)): (a)
//
(* ****** ****** *)

fun{
a:vt0p
} list_tabulate_fun{n:nat}
  (n: int n, f: natLt(n) -<fun1> a): list_vt(a, n)
fun{
a:vt0p
} list_tabulate_clo{n:nat}
  (n: int n, f: &(natLt(n)) -<clo1> a): list_vt(a, n)
fun{
a:vt0p
} list_tabulate_cloref{n:nat}
  (n: int n, f: natLt(n) -<cloref1> a): list_vt(a, n)

(* ****** ****** *)
//
fun{
x,y:t0p
} list_zip{m,n:int}
(
  xs: list(INV(x), m)
, ys: list(INV(y), n)
) :<!wrt> list_vt((x, y), min(m,n))
//
fun
{x,y:t0p}
{res:vt0p}
list_zipwith{m,n:int}
(
  xs: list(INV(x), m)
, ys: list(INV(y), n)
) : list_vt(res, min(m,n)) // endfun
//
fun
{x,y:t0p}
{res:vt0p}
list_zipwith$fopr (x: x, y: y): (res)
//
(* ****** ****** *)
//
fun
{x,y:t0p}
list_cross
  {m,n:int}
(
  xs: list(INV(x), m)
, ys: list(INV(y), n)
) :<!wrt> list_vt((x, y), m*n) // endfun
//
fun
{x,y:t0p}
{res:vt0p}
list_crosswith
  {m,n:int}
(
  xs: list(INV(x), m)
, ys: list(INV(y), n)
) : list_vt(res, m*n) // end of [list_crosswith]
//
fun
{x,y:t0p}
{res:vt0p}
list_crosswith$fopr(x: x, y: y): (res)
//
(* ****** ****** *)

fun
{x:t0p}
list_foreach(xs: List(INV(x))): void
fun
{x:t0p}
{env:vt0p}
list_foreach_env
  (xs: List(INV(x)), env: &(env) >> _): void
//
fun
{x:t0p}
{env:vt0p}
list_foreach$cont (x: x, env: &env): bool
fun
{x:t0p}
{env:vt0p}
list_foreach$fwork (x: x, env: &(env) >> _): void
//
(* ****** ****** *)
//
fun
{x:t0p}
list_foreach_fun
  {fe:eff} (
  xs: List(INV(x)), f: (x) -<fun,fe> void
) :<fe> void // end of [list_foreach_fun]
//
fun
{x:t0p}
list_foreach_clo
  {fe:eff} (
  xs: List(INV(x)), f: &(x) -<clo,fe> void
) :<fe> void // end of [list_foreach_clo]
fun
{x:t0p}
list_foreach_vclo
  {v:view}{fe:eff} (
  pf: !v | xs: List(INV(x)), f: &(!v | x) -<clo,fe> void
) :<fe> void // end of [list_foreach_vclo]
//
fun
{x:t0p}
list_foreach_cloptr
  {fe:eff} (
  xs: List(INV(x)), f: !(x) -<cloptr,fe> void
) :<fe> void // end of [list_foreach_cloptr]
fun
{x:t0p}
list_foreach_vcloptr
  {v:view}{fe:eff} (
  pf: !v | xs: List(INV(x)), f: !(!v | x) -<cloptr,fe> void
) :<fe> void // end of [list_foreach_vcloptr]
//
fun
{x:t0p}
list_foreach_cloref
  {fe:eff} (
  xs: List(INV(x)), f: (x) -<cloref,fe> void
) :<fe> void // end of [list_foreach_cloref]
//
fun
{x:t0p}
list_foreach_funenv
  {v:view}{env:viewtype}{fe:eff}
(
  pfv: !v
| xs: List(INV(x))
, f: (!v | x, !env) -<fun,fe> void
, env: !env
) :<fe> void // end of [list_foreach_funenv]
//
(* ****** ****** *)
//
fun{
x,y:t0p
} list_foreach2
  (xs: List(INV(x)), ys: List(INV(y))): void
//
fun{
x,y:t0p}{env:vt0p
} list_foreach2_env
  (xs: List(INV(x)), ys: List(INV(y)), env: &(env) >> _): void
//
fun{
x,y:t0p}{env:vt0p
} list_foreach2$cont(x: x, y: y, env: &env): bool
fun{
x,y:t0p}{env:vt0p
} list_foreach2$fwork(x: x, y: y, env: &(env) >> _): void
//
(* ****** ****** *)

fun{
x:t0p
} list_iforeach{n:int}
  (xs: list(INV(x), n)): natLte(n)

fun{
x:t0p}{env:vt0p
} list_iforeach_env{n:int}
  (xs: list(INV(x), n), env: &(env) >> _): natLte(n)
//
fun{
x:t0p}{env:vt0p
} list_iforeach$cont(i: intGte(0), x: x, env: &env): bool
fun{
x:t0p}{env:vt0p
} list_iforeach$fwork(i: intGte(0), x: x, env: &(env) >> _): void
//
(* ****** ****** *)

fun{
x:t0p
} list_iforeach_cloref
  {n:int}
(
  xs: list(INV(x), n)
, fwork: (natLt(n), x) -<cloref1> void
) : void // end of [list_iforeach_cloref]

fun{
x:t0p // type for elements
} list_iforeach_funenv
  {v:view}{vt:viewtype}{n:int}{fe:eff} (
  pfv: !v |
  xs: list(INV(x), n)
, fwork: (!v | natLt(n), x, !vt) -<fun,fe> void, env: !vt
) :<fe> int (n) // end of [list_iforeach_funenv]

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

fun{
x,y:t0p
} list_iforeach2{m,n:int}
(
  xs: list(INV(x), m), ys: list(INV(y), n)
) : natLte(min(m,n)) // end-of-function

fun{
x,y:t0p}{env:vt0p
} list_iforeach2_env{m,n:int}
(
  xs: list(INV(x), m), ys: list(INV(y), n), env: &(env) >> _
) : natLte(min(m,n)) // end-of-function
//
fun{
x,y:t0p}{env:vt0p
} list_iforeach2$cont
  (i: intGte(0), x: x, y: y, env: &env): bool
fun{
x,y:t0p}{env:vt0p
} list_iforeach2$fwork
  (i: intGte(0), x: x, y: y, env: &(env) >> _): void
//
(* ****** ****** *)
//
fun{
res:vt0p}{x:t0p
} list_foldleft
  (xs: List(INV(x)), ini: res): res
fun{
res:vt0p}{x:t0p
} list_foldleft$fopr(acc: res, x: x): res
//
fun{
res:vt0p}{x:t0p
} list_foldleft_cloref
  (xs: List(INV(x)), ini: res, fopr: (res, x) -<cloref1> res): res
//
(* ****** ****** *)
//
fun{
x:t0p}{res:vt0p
} list_foldright
  (xs: List(INV(x)), snk: res): res
fun{
x:t0p}{res:vt0p
} list_foldright$fopr(x: x, acc: res): res
//
fun{
x:t0p}{res:vt0p
} list_foldright_cloref
  (xs: List(INV(x)), fopr: (x, res) -<cloref1> res, snk: res): res
//
(* ****** ****** *)
//
// HX-2017-02-19:
// Using [gcompare_val_val] to check
//
fun
{a:t0p}
list_is_ordered(xs: List(INV(a))): bool
//
(* ****** ****** *)
//
fun{a:t0p}
list_mergesort{n:int}
  (xs: list(INV(a), n)):<!wrt> list_vt(a, n)
//
fun{a:t0p}
list_mergesort$cmp(x1: a, x2: a):<> int (* sign *)
//
(* ****** ****** *)

fun{
a:t0p
} list_mergesort_fun
  {n:int} (
  xs: list(INV(a), n), cmp: cmpval (a)
) :<!wrt> list_vt(a, n) // end-of-function

fun{
a:t0p
} list_mergesort_cloref
  {n:int} (
  xs: list(INV(a), n), cmp: (a, a) -<cloref> int
) :<!wrt> list_vt(a, n) // end of [list_mergesort_cloref]

(* ****** ****** *)
//
fun{
a:t0p
} list_quicksort{n:int}
  (xs: list(INV(a), n)) :<!wrt> list_vt(a, n)
//
fun{a:t0p}
list_quicksort$cmp(x1: a, x2: a):<> int (* sign *)
//
(* ****** ****** *)

fun{
a:t0p
} list_quicksort_fun
  {n:int} (
  xs: list(INV(a), n), cmp: cmpval (a)
) :<!wrt> list_vt(a, n) // end-of-function

fun{
a:t0p
} list_quicksort_cloref
  {n:int} (
  xs: list(INV(a), n), cmp: (a, a) -<cloref> int
) :<!wrt> list_vt(a, n) // end of [list_quicksort_cloref]

(* ****** ****** *)
//
fun{a:t0p}
streamize_list_elt
  (xs: List(INV(a))):<!wrt> stream_vt(a)
//
fun{a:t0p}
streamize_list_choose2
  (xs: List(INV(a))):<!wrt> stream_vt(@(a, a))
//
(* ****** ****** *)
//
fun
{a,b:t0p}
streamize_list_zip
  (List(INV(a)), List(INV(b))):<!wrt> stream_vt(@(a, b))
//
fun
{a,b:t0p}
streamize_list_cross
  (List(INV(a)), List(INV(b))):<!wrt> stream_vt(@(a, b))
//
(* ****** ****** *)
//
// HX: overloading
// for certain symbols
//
(* ****** ****** *)
//
overload = with list_equal
//
overload + with list_append
//
(*
overload * with mul_int_list
*)
//
overload [] with list_get_at
//
overload iseqz with list_is_nil
overload isneqz with list_is_cons
//
overload .head with list_head
overload .tail with list_tail
//
overload length with list_length
//
overload copy with list_copy
//
overload print with print_list
overload prerr with prerr_list
overload fprint with fprint_list
overload fprint with fprint_list_sep
//
(* ****** ****** *)

(* end of [list.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(* Author: Hongwei Xi *)
(* Start time: February, 2012 *)
(* Authoremail: gmhwxiATgmailDOTcom *)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/list_vt.atxt
** Time of generation: Fri Aug 18 03:29:53 2017
*)

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

vtypedef
RD(a:vt0p) = a // for commenting: read-only
#define NSH (x) x // for commenting: no sharing
#define SHR (x) x // for commenting: it is shared

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

#if(0)
//
// HX: these decls are available in [basic_dyn.sats]
//
datavtype
list_vt0ype_int_vtype
  (a:vt@ype+, int) =
//
// vt@ype+: covariant
//
  | list_vt_nil(a, 0) of ((*void*))
  | {n:int | n >= 0}
    list_vt_cons(a, n+1) of (a, list_vt0ype_int_vtype(a, n))
// end of [list_vt0ype_int_vtype]
//
stadef
list_vt = list_vt0ype_int_vtype
//
vtypedef
List_vt(a:vt0p) = [n:int] list_vt(a, n)
vtypedef
List0_vt(a:vt0p) = [n:int | n >= 0] list_vt(a, n)
vtypedef
List1_vt(a:vt0p) = [n:int | n >= 1] list_vt(a, n)
vtypedef listLt_vt
  (a:vt0p, n:int) = [k:nat | k < n] list_vt(a, k)
vtypedef listLte_vt
  (a:vt0p, n:int) = [k:nat | k <= n] list_vt(a, k)
vtypedef listGt_vt
  (a:vt0p, n:int) = [k:int | k > n] list_vt(a, k)
vtypedef listGte_vt
  (a:vt0p, n:int) = [k:int | k >= n] list_vt(a, k)
vtypedef listBtw_vt
  (a:vt0p, m:int, n:int) = [k:int | m <= k; k < n] list_vt(a, k)
vtypedef listBtwe_vt
  (a:vt0p, m:int, n:int) = [k:int | m <= k; k <= n] list_vt(a, k)
//
#endif

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

#define nil_vt list_vt_nil
#define cons_vt list_vt_cons

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

prfun
lemma_list_vt_param
  {x:vt0p}{n:int}
  (xs: !list_vt(INV(x), n)): [n >= 0] void
// end of [lemma_list_vt_param]

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

castfn
list_vt_cast
  {x:vt0p}{n:int}
  (xs: list_vt(INV(x), n)):<> list_vt(x, n)
// end of [list_vt_cast]

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

#define list_vt_sing(x)
  list_vt_cons(x, list_vt_nil())
#define list_vt_pair(x1, x2)
  list_vt_cons(x1, list_vt_cons (x2, list_vt_nil()))

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

fun{x:vt0p}
list_vt_make_sing (x: x):<!wrt> list_vt(x, 1)
fun{x:vt0p}
list_vt_make_pair (x1: x, x2: x):<!wrt> list_vt(x, 2)

(* ****** ****** *)
//
fun{x:vt0p}
print_list_vt(xs: !List_vt(INV(x))): void
fun{x:vt0p}
prerr_list_vt(xs: !List_vt(INV(x))): void
//
fun{x:vt0p}
fprint_list_vt
  (out: FILEref, xs: !List_vt(INV(x))): void
fun{} fprint_list_vt$sep (out: FILEref): void
//
fun{x:vt0p}
fprint_list_vt_sep
(
  out: FILEref, xs: !List_vt(INV(x)), sep: NSH(string)
) : void // end of [fprint_list_vt_sep]
//
(* ****** ****** *)
//
fun{x:vt0p}
list_vt_is_nil
  {n:int} (xs: !list_vt(INV(x), n)):<> bool (n==0)
//
fun{x:vt0p}
list_vt_is_cons
  {n:int} (xs: !list_vt(INV(x), n)):<> bool (n > 0)
//
(* ****** ****** *)

fun{x:vt0p}
list_vt_is_sing
  {n:int} (xs: !list_vt(INV(x), n)):<> bool (n==1)
// end of [list_vt_is_sing]

fun{x:vt0p}
list_vt_is_pair
  {n:int} (xs: !list_vt(INV(x), n)):<> bool (n==2)
// end of [list_vt_is_pair]

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

fun{}
list_vt_unnil{x:vt0p} (xs: list_vt(x, 0)):<> void

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

fun{x:vt0p}
list_vt_uncons{n:pos}
  (xs: &list_vt(INV(x), n) >> list_vt(x, n-1)):<!wrt> x
// end of [list_vt_uncons]

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

fun{x:vt0p}
list_vt_length{n:int} (xs: !list_vt(INV(x), n)):<> int n

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

fun{x:vt0p}
list_vt_getref_at
  {n:int}{i:nat | i <= n}
  (xs: &list_vt(INV(x), n), i: int i):<> cPtr1 (list_vt(x, n-i))
// end of [list_vt_getref_at]

(* ****** ****** *)
//
fun{x:t0p}
list_vt_get_at{n:int}
  (xs: !list_vt(INV(x), n), i: natLt n):<> x
//
fun{x:t0p}
list_vt_set_at{n:int}
  (xs: !list_vt(INV(x), n), i: natLt n, x: x):<!wrt> void
//
(* ****** ****** *)

fun{x:vt0p}
list_vt_exch_at{n:int}
  (xs: !list_vt(INV(x), n), i: natLt n, x: &x >> _):<!wrt> void
// end of [list_vt_exch_at]

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

fun{x:vt0p}
list_vt_insert_at{n:int}
(
  xs: &list_vt(INV(x), n) >> list_vt(x, n+1), i: natLte n, x: x
) :<!wrt> void // end of [list_vt_insert_at]

fun{x:vt0p}
list_vt_takeout_at{n:int}
  (xs: &list_vt(INV(x), n) >> list_vt(x, n-1), i: natLt n):<!wrt> x
// end of [list_vt_takeout_at]

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

fun{x:t0p}
list_vt_copy{n:int}
  (xs: !list_vt(INV(x), n)):<!wrt> list_vt(x, n)
// end of [list_vt_copy]

(* ****** ****** *)
//
fun{x:vt0p}
list_vt_copylin{n:int}
  (xs: !list_vt(INV(x), n)):<!wrt> list_vt(x, n)
fun{x:vt0p}
list_vt_copylin$copy (x: &RD(x)): (x)
//
fun{x:vt0p}
list_vt_copylin_fun{n:int}{fe:eff}
  (xs: !list_vt(INV(x), n), f: (&RD(x)) -<fe> x):<!wrt,fe> list_vt(x, n)
//
(* ****** ****** *)

fun{x:t0p}
list_vt_free(xs: List_vt(INV(x))):<!wrt> void

(* ****** ****** *)
//
fun{x:vt0p}
list_vt_freelin
  (xs: List_vt(INV(x))):<!wrt> void
fun{x:vt0p}
list_vt_freelin$clear (x: &x >> x?):<!wrt> void
//
fun{x:vt0p}
list_vt_freelin_fun{fe:eff}
  (xs: List_vt(INV(x)), f: (&x>>x?) -<fe> void):<!wrt,fe> void
//
(* ****** ****** *)
//
fun{
x:vt0p
} list_vt_uninitize
  {n:int} (
  xs: !list_vt(INV(x), n) >> list_vt(x?, n)
) :<!wrt> void // end of [list_vt_uninitize]
//
fun{x:vt0p}
list_vt_uninitize$clear (x: &(x) >> x?):<!wrt> void
//
fun{
x:vt0p
} list_vt_uninitize_fun
  {n:int}{fe:eff}
(
  xs: !list_vt(INV(x), n) >> list_vt(x?, n), f: (&x>>x?) -<fe> void
) :<!wrt,fe> void // end of [list_vt_uninitize_fun]
//
(* ****** ****** *)

fun{
a:vt0p
} list_vt_append
  {n1,n2:int} (
  xs1: list_vt(INV(a), n1), xs2: list_vt(a, n2)
) :<!wrt> list_vt(a, n1+n2) // endfun

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

fun{
x:vt0p
} list_vt_extend{n:int}
  (xs1: list_vt(INV(x), n), x2: x):<!wrt> list_vt(x, n+1)
// end of [list_vt_extend]

fun{x:vt0p}
list_vt_unextend{n:pos}
  (xs: &list_vt(INV(x), n) >> list_vt(x, n-1)):<!wrt> (x)
// end of [list_vt_unextend]

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

macdef list_vt_snoc = list_vt_extend
macdef list_vt_unsnoc = list_vt_unextend

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

fun{x:vt0p}
list_vt_reverse{n:int}
  (xs: list_vt(INV(x), n)):<!wrt> list_vt(x, n)
// end of [list_vt_reverse]

fun{a:vt0p}
list_vt_reverse_append{m,n:int}
  (list_vt(INV(a), m), list_vt(a, n)):<!wrt> list_vt(a, m+n)
// end of [list_vt_reverse_append]

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

fun{x:vt0p}
list_vt_split_at
  {n:int}{i:nat | i <= n}
  (list_vt(INV(x), n), int i):<!wrt> (list_vt(x, i), list_vt(x, n-i))
// end of [list_vt_split_at]

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

fun{x:vt0p}
list_vt_concat
  (xss: List_vt(List_vt(INV(x)))):<!wrt> List0_vt(x)
// end of [list_vt_concat]

(* ****** ****** *)
//
fun{x:t0p}
list_vt_filter{n:int}
  (list_vt(INV(x), n)):<!wrt> listLte_vt(x, n)
// end of [list_vt_filter]
//
fun{x:t0p}
list_vt_filter$pred (x: &RD(x)):<> bool
//
(* ****** ****** *)
//
fun{x:vt0p}
list_vt_filterlin{n:int}
  (list_vt(INV(x), n)):<!wrt> listLte_vt(x, n)
//
fun{x:vt0p}
list_vt_filterlin$pred (x: &RD(x)):<> bool
fun{x:vt0p}
list_vt_filterlin$clear (x: &x >> x?):<!wrt> void
//
(* ****** ****** *)

fun{x:vt0p}
list_vt_separate{n:int}
(
xs: &list_vt(INV(x), n) >> list_vt(x, n1), n1: &int? >> int(n1)
) : #[n1:nat|n1 <= n] list_vt(x, n-n1)

fun{x:vt0p}
list_vt_separate$pred(x: &RD(x)): bool

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

fun{x:vt0p}
list_vt_take_until{n:int}
(
xs: &list_vt(INV(x), n) >> list_vt(x, n-n1), n1: &int? >> int(n1)
) : #[n1:nat|n1 <= n] list_vt(x, n1)

fun{x:vt0p}
list_vt_take_until$pred(x: &RD(x)): bool

(* ****** ****** *)
//
fun
{x:vt0p}
list_vt_app
  (xs: !List_vt(INV(x))): void
fun
{x:vt0p}
list_vt_app$fwork (x: &x >> _): void
//
(* ****** ****** *)
//
fun{x:vt0p}
list_vt_appfree
  (xs: List_vt(INV(x))): void
//
fun{x:vt0p}
list_vt_appfree$fwork (x: &x >> x?): void
//
(* ****** ****** *)
//
fun{
x:vt0p}{y:vt0p
} list_vt_map$fopr(x: &x >> _): (y)
//
fun{
x:vt0p}{y:vt0p
} list_vt_map{n:int}
  (xs: !list_vt(INV(x), n)): list_vt(y, n)
//
(* ****** ****** *)

fun{
x:vt0p}{y:vt0p
} list_vt_map_fun{n:int}
  (xs: !list_vt(INV(x), n), f: (&x) -<fun1> y): list_vt(y, n)
fun{
x:vt0p}{y:vt0p
} list_vt_map_clo{n:int}
  (xs: !list_vt(INV(x), n), f: &(&x) -<clo1> y): list_vt(y, n)
fun{
x:vt0p}{y:vt0p
} list_vt_map_cloref{n:int}
  (xs: !list_vt(INV(x), n), f: (&x) -<cloref1> y): list_vt(y, n)

(* ****** ****** *)
//
fun{
x:vt0p}{y:vt0p
} list_vt_mapfree$fopr(x: &(x) >> x?): (y)
//
fun{
x:vt0p}{y:vt0p
} list_vt_mapfree{n:int}
  (xs: list_vt(INV(x), n)) : list_vt(y, n)
//
(* ****** ****** *)

fun{
x:vt0p}{y:vt0p
} list_vt_mapfree_fun{n:int}
  (xs: list_vt(INV(x), n), f: (&x>>_?) -<fun1> y): list_vt(y, n)
fun{
x:vt0p}{y:vt0p
} list_vt_mapfree_clo{n:int}
  (xs: list_vt(INV(x), n), f: &(&x>>_?) -<clo1> y): list_vt(y, n)
fun{
x:vt0p}{y:vt0p
} list_vt_mapfree_cloref{n:int}
  (xs: list_vt(INV(x), n), f: ( &x>>_? ) -<cloref1> y): list_vt(y, n)

(* ****** ****** *)
//
fun{
x:vt0p
} list_vt_foreach (xs: !List_vt(INV(x))): void
//
fun{
x:vt0p}{env:vt0p
} list_vt_foreach_env (xs: !List_vt(INV(x)), env: &(env) >> _): void
//
fun{
x:vt0p}{env:vt0p
} list_vt_foreach$cont (x: &x, env: &env): bool
fun{
x:vt0p}{env:vt0p
} list_vt_foreach$fwork (x: &x >> _, env: &(env) >> _): void
//
(* ****** ****** *)

fun{
x:vt0p
} list_vt_foreach_fun
  {fe:eff} (
  xs: !List_vt(INV(x)), f: (&x) -<fe> void
) :<fe> void // end of [list_vt_foreach_fun]
fun{
x:vt0p
} list_vt_foreach_cloref
  {fe:eff} (
  xs: !List_vt(INV(x)), f: (&x) -<cloref,fe> void
) :<fe> void // end of [list_vt_foreach_cloref]
fun{
x:vt0p
} list_vt_foreach_funenv
  {v:view}{vt:viewtype}{fe:eff} (
  pfv: !v
| xs: !List_vt(INV(x)), f: (!v | &x, !vt) -<fe> void, env: !vt
) :<fe> void // end of [list_vt_foreach_funenv]

(* ****** ****** *)
//
fun{
x:vt0p
} list_vt_iforeach
  {n:int} (xs: !list_vt(INV(x), n)): natLte(n)
//
fun{
x:vt0p}{env:vt0p
} list_vt_iforeach_env
  {n:int} (xs: !list_vt(INV(x), n), env: &(env) >> _): natLte(n)
//
fun{
x:vt0p}{env:vt0p
} list_vt_iforeach$cont
  (i: intGte(0), x: &x, env: &env): bool
fun{
x:vt0p}{env:vt0p
} list_vt_iforeach$fwork
  (i: intGte(0), x: &x >> _, env: &(env) >> _): void
//
(* ****** ****** *)
//
(*
HX-2016-12:
Fisher–Yates shuffle
*)
//
fun{a:t0p}
list_vt_permute
  {n:int}(xs: list_vt(INV(a), n)): list_vt(a, n)
//
fun{(*void*)}
list_vt_permute$randint{n:int | n > 0}(int(n)): natLt(n)
//
(* ****** ****** *)
//
fun{
a:vt0p
} list_vt_mergesort
  {n:int} (xs: list_vt(INV(a), n)):<!wrt> list_vt(a, n)
fun{
a:vt0p
} list_vt_mergesort$cmp(x1: &RD(a), x2: &RD(a)):<> int(*sgn*)
//
fun{
a:vt0p
} list_vt_mergesort_fun
  {n:int} (
  xs: list_vt(INV(a), n), cmp: cmpref (a)
) :<!wrt> list_vt(a, n) // end of [list_vt_mergesort_fun]
//
(* ****** ****** *)
//
fun{
a:vt0p
} list_vt_quicksort
  {n:int} (xs: list_vt(INV(a), n)):<!wrt> list_vt(a, n)
fun{
a:vt0p
} list_vt_quicksort$cmp(x1: &RD(a), x2: &RD(a)):<> int(*sgn*)
//
fun{
a:vt0p
} list_vt_quicksort_fun
  {n:int} (
  xs: list_vt(INV(a), n), cmp: cmpref (a)
) :<!wrt> list_vt(a, n) // end of [list_vt_quicksort_fun]
//
(* ****** ****** *)
//
fun{a:vt0p}
streamize_list_vt_elt(List_vt(INV(a))):<!wrt> stream_vt(a)
//
(* ****** ****** *)
//
// HX: overloading
// for certain symbols
//
(* ****** ****** *)
//
overload [] with list_vt_get_at
overload [] with list_vt_set_at
//
overload iseqz with list_vt_is_nil
overload isneqz with list_vt_is_cons
//
overload length with list_vt_length
//
overload copy with list_vt_copy
overload free with list_vt_free
//
overload print with print_list_vt
overload prerr with prerr_list_vt
overload fprint with fprint_list_vt
overload fprint with fprint_list_vt_sep
//
(* ****** ****** *)

(* end of [list_vt.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/option.atxt
** Time of generation: Fri Aug 18 03:29:53 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: February, 2012 *)

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

sortdef t0p = t@ype

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

#if(0)
//
// HX:
// these declarations
// are available in [basic_dyn.sats]
//
stadef
option = option_t0ype_bool_type
typedef
Option (a:t0p) = [b:bool] option(a, b)
#endif

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

exception NotSomeExn of ()
(*
fun
NotSomeExn
  ():<> exn = "mac#%NotSomeExn_make"
fun
isNotSomeExn
  (x: !exn):<> bool = "mac#%isNotSomeExn"
macdef
ifNotSomeExn
  {tres}(exn, body) =
(
let val x = ,(exn) in
(
if isNotSomeExn(x)
  then
    let prval () = __vfree_exn (x) in ,(body) end
  else $raise (x)
) : tres // end of [if]
end (* end of [let] *)
) // end of [ifNotSomeExn]
*)

(* ****** ****** *)
//
castfn
option_cast
  {a:t0p}{b:bool}
(
  opt: option(INV(a), b)
) :<> option(a, b) // end-of-fun
//
(* ****** ****** *)
//
castfn
option_vt2t
  {a:t0p}{b:bool}
(
  opt: option_vt(INV(a), b)
) :<> option(a, b) // end-of-fun
castfn
option_of_option_vt
  {a:t0p}{b:bool}
(
  opt: option_vt(INV(a), b)
) :<> option(a, b) // end-of-fun
//
(* ****** ****** *)
//
fun{a:t0p}
option_some
  (x0: a):<> option(a, true)
//
fun{a:t0p}
option_none
  ((*void*)):<> option(a, false)
//
(* ****** ****** *)
//
fun{}
option2bool
  {a:t0p}{b:bool}
  (opt: option(a, b)):<> bool(b)
//
(* ****** ****** *)

fun{}
option_is_some
  {a:t0p}{b:bool}
  (opt: option(a, b)):<> bool(b)

fun{}
option_is_none
  {a:t0p}{b:bool}
  (opt: option(a, b)):<> bool(~b)

(* ****** ****** *)
//
fun{a:t0p}
option_unsome
  (option(INV(a), true)):<> (a)
//
fun{a:t0p}
option_unsome_exn
  (opt: Option(INV(a))):<!exn> (a)
//
(* ****** ****** *)
//
fun{a:t0p}
option_equal
(
  opt1: Option(a), opt2: Option(a)
) :<> bool // end of [option_equal]
//
fun{a:t0p}
option_equal$eqfn(x1: a, x2: a):<> bool
//
(* ****** ****** *)
//
fun{a:t0p}
print_option(opt: Option(INV(a))): void
fun{a:t0p}
prerr_option(opt: Option(INV(a))): void
fun{a:t0p}
fprint_option(FILEref, Option(INV(a))): void
//
(* ****** ****** *)
//
// overloading for certain symbols
//
(* ****** ****** *)

overload = with option_equal

(* ****** ****** *)
//
overload unsome with option_unsome
//
overload iseqz with option_is_none
overload isneqz with option_is_some
//
overload print with print_option of 0
overload prerr with prerr_option of 0
overload fprint with fprint_option of 0
//
(* ****** ****** *)

(* end of [option.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/option_vt.atxt
** Time of generation: Fri Aug 18 03:29:53 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: February, 2012 *)

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

sortdef vt0p = viewt@ype

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

#if(0)
//
// HX: these decls are available in [basic_dyn.sats]
//
stadef option_vt = option_vt0ype_bool_vtype
vtypedef Option_vt (a:vt0p) = [b:bool] option_vt (a, b)
//
#endif

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

fun{a:vt0p}
option_vt_some (x: a):<!wrt> option_vt (a, true)
fun{a:vt0p}
option_vt_none ((*void*)):<!wrt> option_vt (a, false)

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

fun{
a:vt0p
} option_vt_make_opt
  {b:bool}
(
  b: bool(b)
, x: &opt (INV(a), b) >> a?
) :<!wrt> option_vt(a, b) // end-of-fun

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

fun{}
option_vt_is_some
  {a:vt0p}{b:bool}
  (opt: !option_vt(INV(a), b)):<> bool(b)
// end of [option_vt_is_some]
fun{}
option_vt_is_none
  {a:vt0p}{b:bool}
  (opt: !option_vt(INV(a), b)):<> bool(~b)
// end of [option_vt_is_none]

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

fun
{a:vt0p}
option_vt_unsome
  (opt: option_vt(INV(a), true)):<!wrt> (a)
fun
{a:vt0p}
option_vt_unnone
  (opt: option_vt(INV(a), false)):<!wrt> void

(* ****** ****** *)
//
fun{a:t0p}
option_vt_free
  (opt: Option_vt(INV(a))):<!wrt> void
fun{a:t0p}
option2bool_vt
  {b:bool}(opt: option_vt(INV(a), b)):<!wrt> bool(b)
//
(* ****** ****** *)

fun{a:vt0p}
fprint_option_vt{b:bool}
   (out: FILEref, opt: !option_vt (INV(a), b)): void
overload fprint with fprint_option_vt

(* ****** ****** *)
//
// overloading for certain symbols
//
(* ****** ****** *)

overload iseqz with option_vt_is_none
overload isneqz with option_vt_is_some

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

(* end of [option_vt.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(* Author: Hongwei Xi *)
(* Start time: February, 2012 *)
(* Authoremail: gmhwxiATgmailDOTcom *)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/stream.atxt
** Time of generation: Fri Aug 25 22:54:48 2017
*)

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

sortdef t0p = t@ype

(* ****** ****** *)
//
#if(0)
//
// HX: lazy streams
// It is declared in [basics_dyn]
//
datatype
stream_con
  (a:t@ype+) =
//
// t@ype+: covariant
//
  | stream_nil of ((*void*))
  | stream_cons of (a, stream(a))
//
where stream (a:t@ype) = lazy (stream_con(a))
//
#endif // [#if(0)]
//
(* ****** ****** *)
//
exception StreamSubscriptExn of ((*void*))
//
(*
fun StreamSubscriptExn ():<> exn = "mac#StreamSubscriptExn_make"
fun isStreamSubscriptExn (x: !exn):<> bool = "mac#isStreamSubscriptExn"
*)
//
(* ****** ****** *)
//
fun
{a:t0p}
stream_is_nil(xs: stream(a)): bool
fun
{a:t0p}
stream_is_cons(xs: stream(a)): bool
//
(* ****** ****** *)
//
fun{a:t0p}
stream_make_nil(): stream(a)
fun{a:t0p}
stream_make_cons
  (a, stream(INV(a))):<> stream(a)
//
(* ****** ****** *)
//
fun{a:t0p}
stream_sing(a):<> stream_con(a)
fun{a:t0p}
stream_make_sing(x: a): stream(a)
//
(* ****** ****** *)

fun{a:t0p}
stream2list
  (xs: stream(INV(a))):<!laz> List0_vt(a)
// end of [stream2list]

(* ****** ****** *)
//
fun{a:t0p}
stream_length(stream(INV(a))):<!laz> intGte(0)
//
(* ****** ****** *)

fun{a:t0p}
stream_head_exn(xs: stream(INV(a))):<!laz> (a)
fun{a:t0p}
stream_tail_exn(xs: stream(INV(a))):<!laz> stream(a)

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

fun{a:t0p}
stream_nth_exn
  (xs: stream(INV(a)), n: intGte(0)):<!laz> (a)
// end of [stream_nth_exn]
fun{a:t0p}
stream_nth_opt
  (xs: stream(INV(a)), n: intGte(0)):<!laz> Option_vt(a)
// end of [stream_nth_opt]

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

fun{a:t0p}
stream_get_at_exn
  (xs: stream(INV(a)), n: intGte(0)):<!laz> (a)
// end of [stream_get_at_exn]

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

fun{a:t0p}
stream_takeLte
  (xs: stream(INV(a)), n: intGte(0)): stream_vt(a)
// end of [stream_takeLte]

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

fun{a:t0p}
stream_take_exn{n:nat}
  (xs: stream(INV(a)), n: int n):<!laz> list_vt(a, n)
// end of [stream_take_exn]

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

fun{a:t0p}
stream_drop_exn
  (xs: stream(INV(a)), n: intGte(0)):<!laz> stream(a)
// end of [stream_drop_exn]
fun{a:t0p}
stream_drop_opt
  (xs: stream(INV(a)), n: intGte(0)):<!laz> Option_vt(stream(a))
// end of [stream_drop_opt]

(* ****** ****** *)
//
fun{a:t0p}
stream_append
  (xs: stream(INV(a)), ys: stream(a)):<!laz> stream(a)
//
fun{a:t0p}
stream_concat(xss: stream(stream(INV(a)))):<!laz> stream(a)
//
(* ****** ****** *)
//
fun{a:t0p}
stream_filter
  (xs: stream(INV(a))):<!laz> stream(a)
//
fun{a:t0p} stream_filter$pred (x: a):<> bool
//
fun{a:t0p}
stream_filter_fun
(
  xs: stream(INV(a)), pred: (a) -<fun> bool
) :<!laz> stream(a) // end-of-function
fun{a:t0p}
stream_filter_cloref
(
  xs: stream(INV(a)), pred: (a) -<cloref> bool
) :<!laz> stream(a) // end-of-function
//
(* ****** ****** *)
//
fun{
a:t0p}{b:t0p
} stream_map
  (xs: stream(INV(a))):<!laz> stream(b)
fun{
a:t0p}{b:t0p
} stream_map$fopr (x: a):<(*none*)> (b)
//
fun{
a:t0p}{b:t0p
} stream_map_fun
  (xs: stream(INV(a)), fopr: (a) -<fun> b):<!laz> stream(b)
fun{
a:t0p}{b:t0p
} stream_map_cloref
  (xs: stream(INV(a)), fopr: (a) -<cloref> b):<!laz> stream(b)
//
(* ****** ****** *)
//
fun{
a:t0p}{b:t0p
} stream_imap
  (xs: stream(INV(a))):<!laz> stream(b)
//
fun{
a:t0p}{b:t0p
} stream_imap$fopr (i: intGte(0), x: a):<> (b)
//
fun{
a:t0p}{b:t0p
} stream_imap_fun
(
  xs: stream(INV(a)), fopr: (intGte(0), a) -<fun> b
) :<!laz> stream(b) // end-of-fun
fun{
a:t0p}{b:t0p
} stream_imap_cloref
(
  xs: stream(INV(a)), fopr: (intGte(0), a) -<cloref> b
) :<!laz> stream(b) // end-of-fun
//
(* ****** ****** *)
//
fun{
a1,a2:t0p}{b:t0p
} stream_map2
(
  xs1: stream(INV(a1))
, xs2: stream(INV(a2))
) :<!laz> stream(b) // end-of-fun
fun{
a1,a2:t0p}{b:t0p
} stream_map2$fopr (x1: a1, x2: a2):<> b
//
fun{
a1,a2:t0p}{b:t0p
} stream_map2_fun
(
  xs1: stream(INV(a1))
, xs2: stream(INV(a2)), fopr: (a1, a2) -<fun> b
) :<!laz> stream(b) // end-of-fun
fun{
a1,a2:t0p}{b:t0p
} stream_map2_cloref
(
  xs1: stream(INV(a1))
, xs2: stream(INV(a2)), fopr: (a1, a2) -<cloref> b
) :<!laz> stream(b) // end-of-fun
//
(* ****** ****** *)
//
fun{
res:t0p}{x:t0p
} stream_scan
  (stream(INV(x)), ini: res):<!laz> stream(res)
//
fun{
res:t0p}{x:t0p
} stream_scan$fopr(res: res, x: x):<(*none*)> res
//
fun{
res:t0p}{x:t0p
} stream_scan_fun
(
  stream(INV(x)), ini: res, (res, x) -<fun> res
) :<!laz> stream(res) // end-of-function
//
fun{
res:t0p}{x:t0p
} stream_scan_cloref
(
  stream(INV(x)), ini: res, (res, x) -<cloref> res
) :<!laz> stream(res) // end-of-function
//
(* ****** ****** *)
//
// HX: duplicates are kept
//
fun
{a:t0p}
stream_merge
(
  xs1: stream(INV(a)), xs2: stream(a)
) :<!laz> stream(a) // end-of-function
//
fun{a:t0p}
stream_merge$cmp (x1: a, x2: a):<> int
//
fun
{a:t0p}
stream_merge_fun
(
  xs1: stream(INV(a))
, xs2: stream(a), cmp: (a, a) -<fun> int
) :<!laz> stream(a) // end of [stream_merge_fun]
fun
{a:t0p}
stream_merge_cloref
(
  xs1: stream(INV(a))
, xs2: stream(a), cmp: (a, a) -<cloref> int
) :<!laz> stream(a) // end of [stream_merge_cloref]

(* ****** ****** *)
//
// HX: duplicates are dropped
//
fun{a:t0p}
stream_mergeq
(
  xs1: stream(INV(a)), xs2: stream(a)
) :<!laz> stream(a)
//
fun{a:t0p}
stream_mergeq$cmp(x1: a, x2: a):<> int
//
fun{a:t0p}
stream_mergeq_fun
(
  xs1: stream(INV(a))
, xs2: stream(a), cmp: (a, a) -<fun> int
) :<!laz> stream(a) // end-of-function
fun{a:t0p}
stream_mergeq_cloref
(
  xs1: stream(INV(a))
, xs2: stream(a), cmp: (a, a) -<cloref> int
) :<!laz> stream(a) // end-of-function
//
(* ****** ****** *)
//
// HX-2017-06-13:
// The streams are assumed to be ordered!!!
//
fun{a:t0p}
stream_union$cmp(x1: a, x2: a):<> int
fun{a:t0p}
stream_inter$cmp(x1: a, x2: a):<> int
fun{a:t0p}
stream_differ$cmp(x1: a, x2: a):<> int
fun{a:t0p}
stream_symdiff$cmp(x1: a, x2: a):<> int
//
fun{a:t0p}
stream_union
  (stream(INV(a)), stream(a)):<!laz> stream(a)
fun{a:t0p}
stream_inter
  (stream(INV(a)), stream(a)):<!laz> stream(a)
fun{a:t0p}
stream_differ
  (stream(INV(a)), stream(a)):<!laz> stream(a)
fun{a:t0p}
stream_symdiff
  (stream(INV(a)), stream(a)):<!laz> stream(a)
//
(* ****** ****** *)
//
fun
{a:t0p}
stream_tabulate(): stream(a)
fun
{a:t0p}
stream_tabulate$fopr(i: intGte(0)): (a)
//
fun
{a:t0p}
stream_tabulate_fun
  (fopr: intGte(0) -> a): stream(a)
fun
{a:t0p}
stream_tabulate_cloref
  (fopr: intGte(0) -<cloref1> a): stream(a)
//
(* ****** ****** *)
//
fun
{a:t0p}
stream_labelize
  (stream(INV(a))): stream(@(intGte(0), a))
//
(* ****** ****** *)
//
fun
{a:t0p}
stream_foreach(xs: stream(a)): void
fun
{a:t0p}
{env:vt0p}
stream_foreach_env(xs: stream(a), &env >> _): void
//
fun
{a:t0p}
{env:vt0p}
stream_foreach$cont(x: a, env: &env): bool
fun
{a:t0p}
{env:vt0p}
stream_foreach$fwork(x: a, env: &env): void
//
fun{a:t0p}
stream_foreach_fun
  (xs: stream(a), fwork: (a) -<fun1> void): void
fun{a:t0p}
stream_foreach_cloref
  (xs: stream(a), fwork: (a) -<cloref1> void): void
//
(* ****** ****** *)
//
fun{a:t0p}
stream_iforeach_fun
( xs: stream(a)
, fwork: (intGte(0), a) -<fun1> void): void
fun{a:t0p}
stream_iforeach_cloref
( xs: stream(a)
, fwork: (intGte(0), a) -<cloref1> void): void
//
(* ****** ****** *)
//
fun{
res:vt0p}{a:t0p
} stream_foldleft_fun
  (xs: stream(a), ini: res, fopr: (res, a) -<fun1> res): res
fun{
res:vt0p}{a:t0p
} stream_foldleft_cloref
  (xs: stream(a), ini: res, fopr: (res, a) -<cloref1> res): res
//
(* ****** ****** *)
//
fun{}
fprint_stream$sep (out: FILEref): void
fun{a:t0p}
fprint_stream
  (out: FILEref, xs: stream(INV(a)), n: int): void
//
(* ****** ****** *)
//
fun{a:t0p}
stream_skip_while_cloref
  (xs: &stream(INV(a)) >> _, test: (a) -<cloref1> bool): intGte(0)
fun{a:t0p}
stream_skip_until_cloref
  (xs: &stream(INV(a)) >> _, test: (a) -<cloref1> bool): intGte(0)
//
(* ****** ****** *)
//
// overloading for certain symbols
//
(* ****** ****** *)

overload + with stream_append

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

overload [] with stream_nth_exn

(* ****** ****** *)
//
overload iseqz with stream_is_nil
overload isneqz with stream_is_cons
//
(* ****** ****** *)
//
overload length with stream_length
//
(* ****** ****** *)
//
overload .head with stream_head_exn
overload .tail with stream_tail_exn
//
(* ****** ****** *)

(* end of [stream.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(* Author: Hongwei Xi *)
(* Start time: February, 2012 *)
(* Authoremail: gmhwxiATgmailDOTcom *)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/stream_vt.atxt
** Time of generation: Fri Aug 18 03:29:55 2017
*)

(* ****** ****** *)
(*
sortdef
t0p = t@ype and vt0p = vt@ype
*)
(* ****** ****** *)
//
#if(0)
//
// HX: linear lazy streams
// It is declared in [basics_dyn]
//
datavtype
stream_vt_con
  (a:vt@ype+) =
//
// vt@ype+: covariant
//
  | stream_vt_nil of ((*void*))
  | stream_vt_cons of (a, stream_vt(a))
//
where
stream_vt
  (a:vt@ype) = lazy_vt(stream_vt_con(a))
//
#endif // [#if(0)]
//
vtypedef
streamopt_vt(a:vt0p) = Option_vt(stream_vt(a))
//
(* ****** ****** *)
//
fun
{a:t0p}
stream_vt_is_nil(stream_vt(a)): bool
fun
{a:t0p}
stream_vt_is_cons(stream_vt(a)): bool
//
(* ****** ****** *)
//
fun
{a:vt0p}
stream_vt_make_nil():<> stream_vt(a)
fun{a:t0p}
stream_vt_make_cons
  (a, stream_vt(INV(a))):<> stream_vt(a)
//
(* ****** ****** *)
//
fun{a:t0p}
stream_vt_sing(a):<> stream_vt_con(a)
fun{a:t0p}
stream_vt_make_sing(x: a):<> stream_vt(a)
//
(* ****** ****** *)
//
fun{a:t0p}
stream_vt_make_con
  (xs_con: stream_vt_con(INV(a))):<> stream_vt(a)
//
(* ****** ****** *)
//
// HX-2014-04-07:
// this is a regular function
// instead of a cast function
//
fun{a:t0p}
stream_vt2t
  (xs: stream_vt(INV(a))): stream(a)
//
(* ****** ****** *)

fun{a:vt0p}
stream2list_vt
  (xs: stream_vt(INV(a))): List0_vt(a)
// end of [stream2list_vt]

(* ****** ****** *)
//
fun
{a:vt0p}
stream_vt_free
  (xs: stream_vt(a)):<!wrt> void
//
fun{a:t0p}
stream_vt_con_free
  (xs_con: stream_vt_con(a)):<!wrt> void
//
(* ****** ****** *)
//
fun{a:vt0p}
stream_vt_takeLte
  (xs: stream_vt(INV(a)), n: intGte(0)): stream_vt(a)
// end of [stream_vt_takeLte]
//
overload .takeLte with stream_vt_takeLte
//
(* ****** ****** *)
//
fun{a:t0p}
stream_vt_drop_exn
  (xs: stream_vt(INV(a)), n: intGte(0)): stream_vt(a)
// end of [stream_vt_drop_exn]
//
fun{a:t0p}
stream_vt_drop_opt
  (xs: stream_vt(INV(a)), n: intGte(0)): streamopt_vt(a)
// end of [stream_vt_drop_opt]
//
(* ****** ****** *)
//
fun{a:t0p}
stream_vt_length
  (xs: stream_vt(INV(a))):<!wrt> intGte(0)
//
(* ****** ****** *)
//
fun{a:t0p}
stream_vt_head_exn
  (stream_vt(INV(a))):<!exnwrt> (a)
fun{a:t0p}
stream_vt_tail_exn
  (stream_vt(INV(a))):<!exnwrt> stream_vt(a)
//
fun{a:vt0p}
stream_vt_uncons_exn
  (xs: &stream_vt(INV(a)) >> _):<!exnwrt> (a)
fun{a:vt0p}
stream_vt_uncons_opt
  (xs: &stream_vt(INV(a)) >> _):<!exnwrt> Option_vt(a)
//
(* ****** ****** *)
//
fun{a:t0p}
stream_vt_last_exn
  (stream_vt(INV(a))):<!exnwrt> (a)
fun{a:t0p}
stream_vt_last_opt
  (stream_vt(INV(a))):<!exnwrt> Option_vt(a)
//
(* ****** ****** *)
//
fun{a:t0p}
stream_vt_nth_exn
  (xs: stream_vt(INV(a)), n: intGte(0)):<!exnwrt> (a)
fun{a:t0p}
stream_vt_nth_opt
  (xs: stream_vt(INV(a)), n: intGte(0)):<!wrt> Option_vt(a)
//
(* ****** ****** *)
//
fun{a:vt0p}
stream_vt_append
  (stream_vt(INV(a)), stream_vt(a)): stream_vt(a)
//
fun{a:vt0p}
stream_vt_concat
  (xss: stream_vt(stream_vt(INV(a)))): stream_vt(a)
//
(* ****** ****** *)
//
fun{a:t0p}
stream_vt_filter
  (xs: stream_vt(INV(a))): stream_vt(a)
//
fun{a:t0p}
stream_vt_filter_fun
(
  xs: stream_vt(INV(a)), pred: (&a) -<fun> bool
) : stream_vt (a) // end of [stream_vt_filter_fun]
//
fun{a:t0p}
stream_vt_filter_cloptr
(
  xs: stream_vt(INV(a)), pred: (&a) -<cloptr1> bool
) : stream_vt (a) // end of [stream_vt_filter_cloptr]
fun{a:t0p}
stream_vt_ifilter_cloptr
(
  xs: stream_vt(INV(a)), pred: (intGte(0), &a) -<cloptr1> bool
) : stream_vt (a) // end of [stream_vt_ifilter_cloptr]
//
fun{a:vt0p}
stream_vt_filterlin
  (xs: stream_vt(INV(a))): stream_vt(a)
//
fun{a:t0p}
stream_vt_filter$pred(x: &a):<> bool
fun{a:vt0p}
stream_vt_filterlin$pred(x: &a):<> bool
fun{a:vt0p}
stream_vt_filterlin$clear(x: &a >> a?):<!wrt> void
//
(* ****** ****** *)
//
fun{
a:vt0p}{b:vt0p
} stream_vt_map
  (xs: stream_vt(INV(a))): stream_vt(b)
fun{
a:vt0p}{b:vt0p
} stream_vt_map$fopr(x: &a >> a?!):<1> (b)
//
fun{
a:vt0p}{b:vt0p
} stream_vt_map_fun
(
xs: stream_vt(INV(a)), fopr: (&a >> a?!) -<fun1> b
) : stream_vt(b) // end-of-function
fun{
a:vt0p}{b:vt0p
} stream_vt_map_cloptr
(
xs: stream_vt(INV(a)), fopr: (&a >> a?!) -<cloptr1> b
) : stream_vt(b) // end-of-function
//
(* ****** ****** *)
//
fun{
a:vt0p}{b:vt0p
} stream_vt_imap
  (xs: stream_vt(INV(a))): stream_vt(b)
//
fun{
a:vt0p}{b:vt0p
} stream_vt_imap$fopr(i: intGte(0), x: &a >> a?!):<1> (b)
//
fun{
a:vt0p}{b:vt0p
} stream_vt_imap_fun
(
xs: stream_vt(INV(a)), fopr: (intGte(0), &a >> a?!) -<fun1> b
) : stream_vt(b) // end-of-function
fun{
a:vt0p}{b:vt0p
} stream_vt_imap_cloptr
(
xs: stream_vt(INV(a)), fopr: (intGte(0), &a >> a?!) -<cloptr1> b
) : stream_vt(b) // end-of-function
//
(* ****** ****** *)
//
fun
{a:vt0p}
{b:vt0p}
stream_vt_mapopt
(xs: stream_vt(INV(a))): stream_vt(b)
fun
{a:vt0p}
{b:vt0p}
stream_vt_mapopt$fopr(x: &a >> a?!): Option_vt(b)
//
fun{
a:vt0p}{b:vt0p
} stream_vt_mapopt_fun
(
xs: stream_vt(INV(a)), fopr: (&a >> a?!) -<fun1> Option_vt(b)
) : stream_vt(b) // end-of-function
fun{
a:vt0p}{b:vt0p
} stream_vt_mapopt_cloptr
(
xs: stream_vt(INV(a)), fopr: (&a >> a?!) -<cloptr1> Option_vt(b)
) : stream_vt(b) // end-of-function
//
(* ****** ****** *)
//
fun
{a1
,a2:t0p}
{b0:vt0p}
stream_vt_map2
(
  xs1: stream_vt(INV(a1))
, xs2: stream_vt(INV(a2))
) : stream_vt(b0) // end of [stream_vt_map2]
//
fun
{a1
,a2:t0p}
{b0:vt0p}
stream_vt_map2$fopr(x1: &a1 >> _, x2: &a2 >> _):<1> b0
//
fun{
a1,a2:t0p}{b0:vt0p
} stream_vt_map2_fun
(
  xs1: stream_vt(INV(a1))
, xs2: stream_vt(INV(a2)), fopr: (&a1 >> _, &a2 >> _) -<fun1> b0
) : stream_vt(b0) // end of [stream_vt_map2_fun]
fun{
a1,a2:t0p}{b0:vt0p
} stream_vt_map2_cloptr
(
  xs1: stream_vt(INV(a1))
, xs2: stream_vt(INV(a2)), fopr: (&a1 >> _, &a2 >> _) -<cloptr1> b0
) : stream_vt(b0) // end of [stream_vt_map2_cloptr]
//
(* ****** ****** *)
//
fun{
res:t0p
}{a:vt0p}
stream_vt_scan_cloptr
(
  xs: stream_vt(INV(a))
, ini: res, fopr: (res, &a >> a?!) -<cloptr1> res
) : stream_vt(res) // end of [stream_vt_scan_cloptr]
//
(* ****** ****** *)

fun
{a:vt0p}
stream_vt_tabulate((*void*)): stream_vt(a)
fun
{a:vt0p}
stream_vt_tabulate$fopr(idx: intGte(0)): (a)

(* ****** ****** *)
//
fun
{a:vt0p}
stream_vt_labelize
  (stream_vt(INV(a))): stream_vt(@(intGte(0), a))
//
(* ****** ****** *)
//
fun{a:vt0p}
stream_vt_foreach
  (stream_vt(INV(a))): stream_vt_con(a)
fun{
a:vt0p}{env:vt0p
} stream_vt_foreach_env
  (stream_vt(INV(a)), env: &env >> _): stream_vt_con(a)
//
fun{
a:vt0p}{env:vt0p
} stream_vt_foreach$cont
  (x: &a, env: &env >> _): bool
fun{
a:vt0p}{env:vt0p
} stream_vt_foreach$fwork
  (x: &a >> a?!, env: &env >> _): void // lin-cleared
//
fun{a:vt0p}
stream_vt_foreach_cloptr
(
  stream_vt(INV(a)), fwork: (&a >> a?!) -<cloptr1> void
) : void // end of [stream_vt_foreach_cloptr]
//
fun{a:vt0p}
stream_vt_rforeach_cloptr
(
  stream_vt(INV(a)), fwork: (&a >> a?!) -<cloptr1> void
) : void // end of [stream_vt_rforeach_cloptr]
//
fun{a:vt0p}
stream_vt_iforeach_cloptr
(
  stream_vt(INV(a)), fwork: (intGte(0), &a >> a?!) -<cloptr1> void
) : void // end of [stream_vt_iforeach_cloptr]
//
(* ****** ****** *)
//
fun{
res:vt0p
}{a:vt0p}
stream_vt_foldleft_cloptr
(
  xs: stream_vt(INV(a)), init: res, fopr: (res, &a >> a?!) -<cloptr1> res
) : res // end of [stream_vt_foldleft_cloptr]
//
fun{
res:vt0p
}{a:vt0p}
stream_vt_ifoldleft_cloptr
(
  xs: stream_vt(INV(a)), init: res, fopr: (Nat, res, &a >> a?!) -<cloptr1> res
) : res // end of [stream_vt_ifoldleft_cloptr]
//
(* ****** ****** *)

fun
{env:t0p}{a:t0p}
stream_vt_unfold
(
  st0: env, fopr: (&env >> _) -<cloref1> a
) : stream_vt(a) // end of [stream_vt_unfold]

fun
{env:t0p}{a:t0p}
stream_vt_unfold_opt
(
  st0: env, fopr: (&env >> _) -<cloref1> Option_vt(a)
) : stream_vt(a) // end of [stream_vt_unfold_opt]

(* ****** ****** *)
//
fun
{x,y:t0p}
cross_stream_vt_list
  (xs: stream_vt(INV(x)), ys: List(INV(y))): stream_vt(@(x, y))
fun
{x,y:t0p}
cross_stream_vt_list_vt
  (xs: stream_vt(INV(x)), ys: List_vt(INV(y))): stream_vt(@(x, y))
//
(* ****** ****** *)
//
// HX-2016-07-01:
// [stream_vt_fprint] calls [fprint_val]
//
// HX-2016-09-12:
// Note that (n < 0) means to print all the values
//
fun{}
stream_vt_fprint$beg(out: FILEref): void
fun{}
stream_vt_fprint$end(out: FILEref): void
fun{}
stream_vt_fprint$sep(out: FILEref): void
fun{a:t0p}
stream_vt_fprint(stream_vt(INV(a)), out: FILEref, n: int): void
//
(* ****** ****** *)
//
absvtype
streamer_vtype(a:vt@ype+) = ptr
//
vtypedef
streamer_vt(a:vt0p) = streamer_vtype(a)
//
(* ****** ****** *)
//
fun{}
streamer_vt_make
  {a:vt0p}(stream_vt(INV(a))): streamer_vt(a)
//
fun{}
streamer_vt_free{a:vt0p}(streamer_vt(INV(a))): void
//
fun{
a:vt@ype
} streamer_vt_eval_exn(xser: !streamer_vt(INV(a))): (a)
//
(* ****** ****** *)
//
// overloading for certain symbols
//
(* ****** ****** *)

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

overload ~ with streamer_vt_free

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

overload [] with streamer_vt_eval_exn

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

overload iseqz with stream_vt_is_nil
overload isneqz with stream_vt_is_cons

(* ****** ****** *)
//
overload length with stream_vt_length
//
(* ****** ****** *)

overload .head with stream_vt_head_exn
overload .tail with stream_vt_tail_exn

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

(* end of [stream_vt.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/array.atxt
** Time of generation: Fri Aug 18 03:29:54 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: Feburary, 2012 *)

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

vtypedef
RD(a:vt0p) = a // for commenting: read-only
#define NSH (x) x // for commenting: no sharing
#define SHR (x) x // for commenting: it is shared

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

sortdef t0p = t@ype
sortdef vtp = viewtype
sortdef vt0p = viewt@ype

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

(*
//
// HX: [array_v] can also be defined as follows:
//
dataview
array_v
(
  a:vt@ype+, addr, int
) = // HX: for arry view
  | {l:addr}
    array_v_nil (a, l, 0)
  | {l:addr}{n:int}
    array_v_cons (a, l, n+1) of (a @ l, array_v (a, l+sizeof a, n))
// end of [array_v]
*)

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

dataview
arrayopt_v
(
  a:vt@ype+, addr, int, bool
) = // HX: for optional array view
  | {l:addr}{n:int}
    arrayopt_v_some (a, l, n, true) of array_v (a, l, n)
  | {l:addr}{n:int}
    arrayopt_v_none (a, l, n, false) of array_v (a?, l, n)
// end of [arrayopt_v]

(* ****** ****** *)
//
exception
ArraySubscriptExn of ()
//
(*
fun
ArraySubscriptExn():<> exn = "mac#%ArraySubscriptExn_make"
fun
isArraySubscriptExn(x: !exn):<> bool = "mac#%isArraySubscriptExn"
//
macdef
ifArraySubscriptExn
  {tres}(exn, body) =
(
let val x = ,(exn) in
(
//
if
isArraySubscriptExn(x)
then (
  let prval () = __vfree_exn (x) in ,(body) end
) else $raise (x)
//
) : tres // end of [if]
end (* end of [let] *)
) // end of [ifArraySubscriptExn]
*)
//
(* ****** ****** *)
//
praxi
lemma_array_param
  {a:vt0p}{l:addr}{n:int}
  (A: &(@[INV(a)][n])): [n >= 0] void
// end of [lemma_array_param]
//
praxi
lemma_array_v_param
  {a:vt0p}{l:addr}{n:int}
  (pf: !array_v (INV(a), l, n)): [n >= 0] void
// end of [lemma_array_v_param]
//
(* ****** ****** *)
//
praxi
array_v_nil :
  {a:vt0p}{l:addr} () -<prf> array_v (a, l, 0)
//
praxi
array_v_unnil :
  {a:vt0p}{l:addr} array_v (a, l, 0) -<prf> void
//
prfun
array_v_unnil_nil :
  {a1,a2:vt0p}{l:addr} array_v (a1, l, 0) -<prf> array_v (a2, l, 0)
// end of [array_v_unnil_nil]
//
(* ****** ****** *)
//
praxi
array_v_cons :
{a:vt0p}{l:addr}{n:int}
(a @ l, array_v (INV(a), l+sizeof(a), n)) -<prf> array_v (a, l, n+1)
//
praxi
array_v_uncons :
{a:vt0p}{l:addr}{n:int | n > 0}
array_v (INV(a), l, n) -<prf> (a @ l, array_v (a, l+sizeof(a), n-1))
//
(* ****** ****** *)

prfun
array_v_sing
  {a:vt0p}{l:addr} (pf: INV(a) @ l): array_v (a, l, 1)
prfun
array_v_unsing
  {a:vt0p}{l:addr} (pf: array_v (INV(a), l, 1)): a @ l

(* ****** ****** *)
//
fun
{a:vt0p}
array_getref_at
  {n:int} (A: &RD(@[INV(a)][n]), i: sizeLt n):<> cPtr1(a)
//
(* ****** ****** *)
//
fun{
a:t0p}{tk:tk
} array_get_at_gint
  {n:int}
  (A: &RD(@[INV(a)][n]), i: g1intLt(tk, n)):<> a
//
fun{
a:t0p}{tk:tk
} array_get_at_guint
  {n:int}
  (A: &RD(@[INV(a)][n]), i: g1uintLt(tk, n)):<> a
//
overload [] with array_get_at_gint of 0
overload [] with array_get_at_guint of 0
//
symintr array_get_at
overload array_get_at with array_get_at_gint of 0
overload array_get_at with array_get_at_guint of 0
//
(* ****** ****** *)
//
fun{
a:t0p}{tk:tk
} array_set_at_gint
  {n:int}
  (A: &(@[INV(a)][n]), i: g1intLt(tk, n), x: a):<!wrt> void
//
fun{
a:t0p}{tk:tk
} array_set_at_guint
  {n:int}
  (A: &(@[INV(a)][n]), i: g1uintLt(tk, n), x: a):<!wrt> void
//
overload [] with array_set_at_gint of 0
overload [] with array_set_at_guint of 0
//
symintr array_set_at
overload array_set_at with array_set_at_gint of 0
overload array_set_at with array_set_at_guint of 0
//
(* ****** ****** *)

fun{
a:vt0p}{tk:tk
} array_exch_at_gint{n:int}
(
  A: &(@[INV(a)][n]), i: g1intLt (tk, n), x: &a >> _
) :<!wrt> void
fun{
a:vt0p}{tk:tk
} array_exch_at_guint{n:int}
(
  A: &(@[INV(a)][n]), i: g1uintLt (tk, n), x: &a >> _
) :<!wrt> void

symintr array_exch_at
overload array_exch_at with array_exch_at_gint of 0
overload array_exch_at with array_exch_at_guint of 0

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

fun
{a:vt0p}
array_subreverse
 {n:int}
 {i,j:int |
  0 <= i; i <= j; j <= n}
(
  A: &(@[INV(a)][n]), i: size_t(i), j: size_t(j)
) :<!wrt> void // end of [array_subreverse]

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

fun
{a:vt0p}
array_interchange
  {n:int}
(
  A: &(@[INV(a)][n]), i: sizeLt (n), j: sizeLt (n)
) :<!wrt> void // end of [array_interchange]

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

fun
{a:vt0p}
array_subcirculate
  {n:int}
(
  A: &(@[INV(a)][n]), i: sizeLt (n), j: sizeLt (n)
) :<!wrt> void // end of [array_subcirculate]

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

fun
{a:vt0p}
array_ptr_takeout
  {l:addr}{n:int}{i:nat | i < n}
(
  array_v (INV(a), l, n) | ptr l, size_t i
) : (
  a @ (l+i*sizeof(a))
, a @ (l+i*sizeof(a)) -<lin,prf> array_v (a, l, n)
| ptr (l+i*sizeof(a))
) (* end of [array_ptr_takeout] *)

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

fun
{a:vt0p}
array_ptr_alloc
  {n:int}
(
  asz: size_t n
) :<!wrt> [l:agz]
(
  array_v (a?, l, n), mfree_gc_v (l) | ptr l
) (* end of [array_ptr_alloc] *)

fun
{(*void*)}
array_ptr_free
  {a:vt0p}{l:addr}{n:int}
(
  array_v (a?, l, n), mfree_gc_v (l) | ptr l
) :<!wrt> void // end-of-function

(* ****** ****** *)
//
fun
{(*void*)}
fprint_array$sep (out: FILEref): void
//
fun{a:vt0p}
fprint_array_int{n:int}
(
  out: FILEref, A: &RD(@[INV(a)][n]), n: int(n)
) : void // end of [fprint_array_int]
fun{a:vt0p}
fprint_array_size{n:int}
(
  out: FILEref, A: &RD(@[INV(a)][n]), n: size_t(n)
) : void // end of [fprint_array_size]
//
symintr fprint_array
overload fprint_array with fprint_array_int
overload fprint_array with fprint_array_size
//
fun
{a:vt0p}
fprint_array_sep{n:int}
(
  out: FILEref
, A: &RD(@[INV(a)][n]), n: size_t n, sep: NSH(string)
) : void // end of [fprint_array_sep]
//
(* ****** ****** *)

overload fprint with fprint_array
overload fprint with fprint_array_sep

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

fun
{a:vt0p}
array_copy{n:int}
(
  to: &(@[a?][n]) >> @[a][n]
, from: &RD(@[INV(a)][n]) >> @[a?!][n]
, n: size_t (n)
) :<!wrt> void // end of [array_copy]

(* ****** ****** *)
//
fun
{a:t0p}
array_copy_from_list{n:int}
(
  A: &(@[a?][n]) >> @[a][n], xs: list (INV(a), n)
) :<!wrt> void // end of [array_copy_from_list]
//
fun
{a:vt0p}
array_copy_from_list_vt{n:int}
(
  A: &(@[a?][n]) >> @[a][n], xs: list_vt (INV(a), n)
) :<!wrt> void // end of [array_copy_from_list_vt]
//
(* ****** ****** *)

fun
{a:vt0p}
array_copy_to_list_vt{n:int}
(
  A: &RD(@[INV(a)][n]) >> @[a?!][n], n: size_t n
) :<!wrt> list_vt (a, n) // endfun

macdef array2list = array_copy_to_list_vt

(* ****** ****** *)
//
fun
{a:vt0p}
array_tabulate$fopr(i: size_t): (a)
//
fun
{a:vt0p}
array_ptr_tabulate
  {n:int}
(
  asz: size_t(n)
) : [l:addr] (array_v(a, l, n), mfree_gc_v(l) | ptr(l))
// end of [arrayptr_tabulate]
//
(* ****** ****** *)
//
fun{
a:vt0p
} array_foreach{n:int}
(
  A: &(@[INV(a)][n]) >> @[a][n], asz: size_t(n)
) : sizeLte(n) // end of [array_foreach]
//
fun{
a:vt0p}{env:vt0p
} array_foreach_env{n:int}
(
  A: &(@[INV(a)][n]) >> @[a][n], asz: size_t(n), env: &(env) >> _
) : sizeLte(n) // end of [array_foreach_env]
//
fun{
a:vt0p}{env:vt0p
} array_foreach$cont (x: &a, env: &env): bool
fun{
a:vt0p}{env:vt0p
} array_foreach$fwork (x: &a >> _, env: &(env) >> _): void
//
(* ****** ****** *)
//
fun
{a:vt0p}
array_foreach_funenv
  {v:view}
  {vt:vtype}
  {n:int}
  {fe:eff}
(
  pfv: !v
| A: &(@[INV(a)][n]) >> @[a][n]
, asz: size_t n
, f: (!v | &a >> _, !vt) -<fun,fe> void
, env: !vt
) :<fe> void
// end of [array_foreach_funenv]
//
fun
array_foreach_funenv_tsz
  {a:vt0p}
  {v:view}
  {vt:vtype}
  {n:int}
  {fe:eff}
(
  pfv: !v
| A: &(@[INV(a)][n]) >> @[a][n]
, asz: size_t(n), tsz: sizeof_t(a)
, f: (!v | &a >> _, !vt) -<fun,fe> void
, env: !vt
) :<fe> void = "ext#%"
// end of [array_foreach_funenv_tsz]
//
(* ****** ****** *)
//
fun
{a:vt0p}
array_foreach_fun
  {n:int}{fe:eff}
(
  &(@[INV(a)][n]) >> @[a][n]
, size_t (n), (&a >> _) -<fun,fe> void
) :<fe> void // end of [array_foreach_fun]
fun
{a:vt0p}
array_foreach_clo
  {n:int}{fe:eff}
(
  A: &(@[INV(a)][n]) >> @[a][n]
, asz: size_t (n), f: &(&a >> _) -<clo,fe> void
) :<fe> void // end of [array_foreach_clo]
fun
{a:vt0p}
array_foreach_cloptr
  {n:int}{fe:eff}
(
  A: &(@[INV(a)][n]) >> @[a][n]
, asz: size_t n, f: (&a >> _) -<cloptr,fe> void
) :<fe> void // end of [array_foreach_cloptr]
fun
{a:vt0p}
array_foreach_cloref
  {n:int}{fe:eff}
(
  A: &(@[INV(a)][n]) >> @[a][n]
, asz: size_t(n), f: (&a >> _) -<cloref,fe> void
) :<fe> void // end of [array_foreach_cloref]
//
(* ****** ****** *)
//
fun
{a:vt0p}
array_foreach_vclo
  {v:view}{n:int}{fe:eff}
(
  pfv: !v
| A: &(@[INV(a)][n]) >> @[a][n]
, asz: size_t n, f: &(!v | &a >> _) -<clo,fe> void
) :<fe> void // end of [array_foreach_vclo]
fun
{a:vt0p}
array_foreach_vcloptr
  {v:view}{n:int}{fe:eff}
(
  pfv: !v
| A: &(@[INV(a)][n]) >> @[a][n]
, asz: size_t(n), f: !(!v | &a >> _) -<cloptr,fe> void
) :<fe> void // end of [array_foreach_vcloptr]
//
(* ****** ****** *)

fun{
a1,a2:vt0p
} array_foreach2
  {n:int}
(
  A1: &(@[INV(a1)][n]) >> @[a1][n]
, A2: &(@[INV(a2)][n]) >> @[a2][n]
, asz: size_t (n)
) : sizeLte(n) // end of [array_foreach2]
//
fun{
a1,a2:vt0p}{env:vt0p
} array_foreach2_env
  {n:int}
(
  A1: &(@[INV(a1)][n]) >> @[a1][n]
, A2: &(@[INV(a2)][n]) >> @[a2][n]
, asz:size_t (n)
, env: &(env) >> env
) : sizeLte(n) // end of [array_foreach2_env]
//
fun{
a1,a2:vt0p}{env:vt0p
} array_foreach2$cont
  (x1: &a1, x2: &a2, env: &env): bool
fun{
a1,a2:vt0p}{env:vt0p
} array_foreach2$fwork
  (x1: &a1 >> _, x2: &a2 >> _, env: &(env) >> _): void
//
(* ****** ****** *)

fun{
a:vt0p
} array_iforeach
  {n:int}
(
  A: &(@[INV(a)][n]) >> @[a][n], asz: size_t n
) : sizeLte(n) // end of [array_iforeach]
//
fun{
a:vt0p}{env:vt0p
} array_iforeach_env
  {n:int}
(
  A: &(@[INV(a)][n]) >> @[a][n], asz: size_t n, env: &(env) >> _
) : sizeLte(n) // end of [array_iforeach_env]
//
fun{
a:vt0p}{env:vt0p
} array_iforeach$cont(i: size_t, x: &a, env: &env): bool
fun{
a:vt0p}{env:vt0p
} array_iforeach$fwork(i: size_t, x: &a >> _, env: &(env) >> _): void
//
(* ****** ****** *)

fun{
a:vt0p
} array_rforeach{n:int}
(
  A: &(@[INV(a)][n]) >> @[a][n], asz: size_t(n)
) : sizeLte(n) // end of [array_rforeach]
//
fun{
a:vt0p}{env:vt0p
} array_rforeach_env{n:int}
(
  A: &(@[INV(a)][n]) >> @[a][n], asz: size_t(n), env: &(env) >> _
) : sizeLte(n) // end of [array_rforeach_env]
//
fun{
a:vt0p}{env:vt0p
} array_rforeach$cont(x: &a, env: &env): bool
fun{
a:vt0p}{env:vt0p
} array_rforeach$fwork(x: &a >> _, env: &(env) >> _): void
//
(* ****** ****** *)
//
fun{a:vt0p}
array_initize{n:int}
(
  A: &(@[a?][n]) >> @[a][n], asz: size_t(n)
) : void // end of [array_initize]
//
fun{a:vt0p}
array_initize$init (i: size_t, x: &a? >> a): void
//
(* ****** ****** *)

fun{a:t0p}
array_initize_elt{n:int}
(
  A: &(@[a?][n]) >> @[a][n], asz: size_t n, elt: (a)
) :<!wrt> void // end of [array_initize_elt]

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

fun{a:t0p}
array_initize_list{n:int}
(
  A: &(@[a?][n]) >> @[a][n], asz: int n, xs: list(INV(a), n)
) :<!wrt> void // end of [array_initize_list]
fun{a:t0p}
array_initize_rlist{n:int}
(
  A: &(@[a?][n]) >> @[a][n], asz: int n, xs: list(INV(a), n)
) :<!wrt> void // end of [array_initize_rlist]

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

fun{a:vt0p}
array_initize_list_vt{n:int}
(
  A: &(@[a?][n]) >> @[a][n], asz: int n, xs: list_vt(INV(a), n)
) :<!wrt> void // end of [array_initize_list_vt]
fun{a:vt0p}
array_initize_rlist_vt{n:int}
(
  A: &(@[a?][n]) >> @[a][n], asz: int n, xs: list_vt(INV(a), n)
) :<!wrt> void // end of [array_initize_rlist_vt]

(* ****** ****** *)
//
fun
{a:vt0p}
array_uninitize
  {n:int}
(
  A: &(@[INV(a)][n]) >> @[a?][n], asz: size_t n
) : void // end of [array_uninitize]
//
fun{a:vt0p}
array_uninitize$clear(i: size_t, x: &a >> a?): void
//
(* ****** ****** *)
//
fun{a:vt0p}
array_bsearch$ford (x: &RD(a)):<> int
//
fun
{a:vt0p}
array_bsearch
  {n:int}
  (A: &RD(@[a][n]), n: size_t(n)):<> sizeLte(n)
//
fun
{a:vt0p}
array_bsearch_fun
  {n:int}
(
//
  A: &RD(@[a][n]), asz: size_t(n), key: &RD(a), cmp: cmpref(a)
//
) :<> sizeLte(n) // end of [array_bsearch_fun]
//
(* ****** ****** *)
//
(*
** HX: this one is based on [bsearch] in [stdlib]
*)
fun
{a:vt0p}
array_bsearch_stdlib
  {n:int}
(
  A: &RD(@[a][n]), asz: size_t (n), key: &RD(a), cmp: cmpref(a)
) :<> Ptr0 (* found/~found : ~null/null *)
//
(* ****** ****** *)
//
fun
{a:vt0p}
array_quicksort
  {n:int}
(
  A: &(@[INV(a)][n]) >> @[a][n], n: size_t n
) :<!wrt> void // end-of-function
fun{a:vt0p}
array_quicksort$cmp(x1: &RD(a), x2: &RD(a)):<> int(*sgn*)
//
(* ****** ****** *)

(*
** HX: this one is based on [qsort] in [stdlib]
*)
fun
{a:vt0p}
array_quicksort_stdlib
  {n:int}
(
  A: &(@[INV(a)][n]) >> @[a][n], n: size_t(n), cmp: cmpref(a)
) :<!wrt> void // end of [array_quicksort_stdlib]

(* ****** ****** *)
//
fun{
a:vt0p}{b:vt0p
} array_mapto{n:int}
(
  A: &array(INV(a), n)
, B: &array(b?, n) >> array (b, n)
, n: size_t (n)
) : void // end of [array_mapto]
//
fun{
a:vt0p}{b:vt0p
} array_mapto$fwork(x: &a, y: &b? >> b): void
//
(* ****** ****** *)
//
fun{
a,b:vt0p}{c:vt0p
} array_map2to{n:int}
(
  A: &array(INV(a), n)
, B: &array(INV(b), n)
, C: &array(c?, n) >> array (c, n)
, n: size_t (n)
) : void // end of [array_map2to]
//
fun{
a,b:vt0p}{c:vt0p
} array_map2to$fwork(x: &a, y: &b, z: &c? >> c): void
//
(* ****** ****** *)
//
(*
HX-2016:
Fisher–Yates shuffle
*)
//
fun{a:vt0p}
array_permute{n:int}
  (A: &(@[INV(a)][n]) >> @[a][n], n: size_t(n)): void
//
fun{(*void*)}
array_permute$randint{n:int | n > 0}(size_t(n)): sizeLt(n)
//
(* ****** ****** *)

(* end of [array.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/arrayptr.atxt
** Time of generation: Fri Aug 18 03:29:54 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: February, 2012 *)

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

#define NSH (x) x // for commenting: no sharing
#define SHR (x) x // for commenting: it is shared

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

sortdef t0p = t@ype and vt0p = viewt@ype

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

#if(0)
//
// HX-2013-06:
// it is declared in [basic_dyn.sats]
//
absvtype
arrayptr_vt0ype_addr_int_vtype
  (a:vt0ype+, l: addr, n: int) = ptr(l)
//
stadef
arrayptr = arrayptr_vt0ype_addr_int_vtype
//
vtypedef
arrayptr
  (a:vt0p, n:int) = [l:addr] arrayptr(a, l, n)
//
#endif

(* ****** ****** *)
//
absvtype
arrayptrout_vt0ype_addr_int_vtype
  (a:t@ype, l: addr, n: int) = ptr(l)
//
stadef
arrayptrout = arrayptrout_vt0ype_addr_int_vtype
//
(* ****** ****** *)

praxi
lemma_arrayptr_param{a:vt0p}
  {l:addr}{n:int} (A: !arrayptr(a, l, n)): [n >= 0] void
// end of [lemma_arrayptr_param]

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

castfn
arrayptr_encode :
  {a:vt0p}{l:addr}{n:int}
  (array_v(INV(a), l, n), mfree_gc_v(l) | ptr(l)) -<0> arrayptr(a, l, n)
// end of [arrayptr_encode]
castfn
arrayptr_encode2 :
  {a:vt0p}{l:addr}{n:int}
  @(array_v(INV(a), l, n), mfree_gc_v(l) | ptr(l)) -<0> arrayptr(a, l, n)
// end of [arrayptr_encode2]

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

castfn
arrayptr_objectify
  {a:vt0p}{l:addr}{n:int}
  (array_v(INV(a), l, n) | ptr(l)):<> (mfree_ngc_v(l) | arrayptr(a, l, n))
// end of [arrayptr_objectify]
castfn
arrayptr_unobjectify
  {a:vt0p}{l:addr}{n:int}
  (mfree_ngc_v(l) | arrayptr(INV(a), l, n)):<> (array_v(a, l, n) | ptr(l))
// end of [arrayptr_objectify]

(* ****** ****** *)
//
castfn
arrayptr2ptr
  {a:vt0p}
  {l:addr}{n:int}
  (A: !arrayptr(INV(a), l, n)):<> ptr(l)
castfn
arrayptrout2ptr
  {a:t0p}{l:addr}{n:int}
  (A: !arrayptrout(INV(a), l, n)):<> ptr(l)
//
(* ****** ****** *)

praxi
arrayptr_takeout
  {a:vt0p}{l:addr}{n:int}
(
  A: !arrayptr(INV(a), l, n) >> arrayptrout(a?, l, n)
) : array_v(a, l, n) // end of [arrayptr_takeout]

praxi
arrayptr_addback
  {a:vt0p}{l:addr}{n:int}
(
  pf: array_v(INV(a), l, n) | A: !arrayptrout(a?, l, n) >> arrayptr(a, l, n)
) : void // end of [arrayptr_addback]

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

castfn
arrayptr_takeout_viewptr
  {a:vt0p}{l:addr}{n:int}
(
  A: !arrayptr(INV(a), l, n) >> arrayptrout(a?, l, n)
) : (array_v(a, l, n) | ptr(l)) // endfun

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

castfn
arrpsz_encode :
  {a:vt0p}{n:int}
  @(arrayptr(INV(a), n), size_t(n)) -<0> arrpsz(a, n)
// end of [arrpsz_encode]

castfn
arrpsz_decode :
  {a:vt0p}{n:int}
  arrpsz(INV(a), n) -<0> @(arrayptr(a, n), size_t(n))
// end of [arrpsz_decode]

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

fun
arrpsz_get_ptrsize
  {a:vt0p}{n:int}
(
  psz: arrpsz(INV(a), n), asz: &size_t? >> size_t(n)
) :<!wrt> arrayptr(a, n) = "mac#%" // endfun

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

symintr arrayptr

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

fun{
a:t0p
} arrayptr_make_elt
  {n:int} (asz: size_t(n), x: a):<!wrt> arrayptr(a, n)
// end of [arrayptr_make_elt]

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

fun{}
arrayptr_make_intrange
  {l,r:int | l <= r}
  (l: int l, r: int r):<!wrt> arrayptr(intBtw(l, r), r-l)
// end of [arrayptr_make_intrange]

(* ****** ****** *)
//
// HX: this one is a field-selection
//
fun
arrayptr_make_arrpsz
  {a:vt0p}{n:int}
  (psz: arrpsz(INV(a), n)):<> arrayptr(a, n) = "mac#%"
//
overload arrayptr with arrayptr_make_arrpsz
//
(* ****** ****** *)
//
fun
{a:t0p}
arrayptr_make_list{n:int}
  (asz: int n, xs: list(INV(a), n)):<!wrt> arrayptr(a, n)
// end of [arrayptr_make_list]
//
fun
{a:t0p}
arrayptr_make_rlist{n:int}
  (asz: int n, xs: list(INV(a), n)):<!wrt> arrayptr(a, n)
// end of [arrayptr_make_rlist]
//
(* ****** ****** *)

fun{a:t0p}
arrayptr_make_subarray
  {n:int}{st,ln:int | st+ln <= n}
  (A: RD(arrayref(a, n)), size_t(st), size_t(ln)): arrayptr(a, ln)
// end of [arrayptr_make_subarray]

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

fun
{a:vt0p}
arrayptr_make_list_vt{n:int}
  (asz: int n, xs: list_vt (INV(a), n)):<!wrt> arrayptr(a, n)
// end of [arrayptr_make_list_vt]
fun
{a:vt0p}
arrayptr_make_rlist_vt{n:int}
  (asz: int n, xs: list_vt (INV(a), n)):<!wrt> arrayptr(a, n)
// end of [arrayptr_make_rlist_vt]

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

fun
{a:vt0p}
arrayptr_make_uninitized
  {n:int} (asz: size_t(n)):<!wrt> arrayptr(a?, n)
// end of [arrayptr_make_uninitized]

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

fun
{a:vt0p}
arrayptr_imake_list{n:int}
(
  A: !arrayptr(INV(a), n) >> arrayptr(a?!, n), n: size_t(n)
) : list_vt (a, n) // end of [arrayptr_imake_list]

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

fun
arrayptr_free
  {a:t0p}{l:addr}{n:int}
  (A: arrayptr(INV(a), l, n)):<!wrt> void = "mac#%"
// end of [arrayptr_free]

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

(*
fun{}
fprint_array$sep (out: FILEref): void
*)
fun{a:vt0p}
fprint_arrayptr
  {l:addr}{n:int}
(
  out: FILEref, A: !arrayptr(INV(a), l, n), n: size_t(n)
) : void // end of [fprint_arrayptr]
fun{a:vt0p}
fprint_arrayptr_sep
  {l:addr}{n:int}
(
  out: FILEref
, A: !arrayptr(INV(a), l, n), n: size_t(n), sep: NSH(string)
) : void // end of [fprint_arrayptr_sep]

(* ****** ****** *)
//
fun{
a:t0p}{tk:tk
} arrayptr_get_at_gint
  {n:int}{i:nat | i < n}
  (A: !arrayptr(INV(a), n), i: g1int (tk, i)):<> (a)
fun{
a:t0p}{tk:tk
} arrayptr_get_at_guint
  {n:int}{i:nat | i < n}
  (A: !arrayptr(INV(a), n), i: g1uint (tk, i)):<> (a)
//
symintr arrayptr_get_at
overload arrayptr_get_at with arrayptr_get_at_gint
overload arrayptr_get_at with arrayptr_get_at_guint
//
(* ****** ****** *)
//
fun{
a:t0p}{tk:tk
} arrayptr_set_at_gint
  {n:int}{i:nat | i < n}
  (A: !arrayptr(INV(a), n), i: g1int (tk, i), x: a):<!wrt> void
fun{
a:t0p}{tk:tk
} arrayptr_set_at_guint
  {n:int}{i:nat | i < n}
  (A: !arrayptr(INV(a), n), i: g1uint (tk, i), x: a):<!wrt> void
//
symintr arrayptr_set_at
overload arrayptr_set_at with arrayptr_set_at_gint of 0
overload arrayptr_set_at with arrayptr_set_at_guint of 0
//
(* ****** ****** *)
//
fun{
a:vt0p}{tk:tk
} arrayptr_exch_at_gint
  {n:int}{i:nat | i < n}
  (A: !arrayptr(INV(a), n), i: g1int (tk, i), x: &a >> _):<!wrt> void
// end of [arrayptr_exch_at_gint]
//
fun{
a:vt0p}{tk:tk
} arrayptr_exch_at_guint
  {n:int}{i:nat | i < n}
  (A: !arrayptr(INV(a), n), i: g1uint (tk, i), x: &a >> _):<!wrt> void
// end of [arrayptr_exch_at_guint]
//
symintr arrayptr_exch_at
overload arrayptr_exch_at with arrayptr_exch_at_gint of 0
overload arrayptr_exch_at with arrayptr_exch_at_guint of 0
//
(* ****** ****** *)

fun{a:vt0p}
arrayptr_interchange
  {n:int}
(
  A: !arrayptr(INV(a), n), i: sizeLt n, j: sizeLt n
) :<!wrt> void // end of [arrayptr_interchange]

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

(*
fun{a:vt0p}{env:vt0p}
array_foreach$cont (x: &a, env: &env): void
fun{a:vt0p}{env:vt0p}
array_foreach$fwork (x: &a >> a, env: &(env) >> _): void
*)
fun{
a:vt0p
} arrayptr_foreach{n:int}
(
  A: !arrayptr(INV(a), n), asz: size_t(n)
) : sizeLte(n) // end of [arrayptr_foreach]
fun{
a:vt0p}{env:vt0p
} arrayptr_foreach_env{n:int}
(
  A: !arrayptr(INV(a), n), asz: size_t(n), env: &(env) >> _
) : sizeLte(n) // end of [arrayptr_foreach_env]

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

fun
{a:vt0p}
arrayptr_foreach_fun
  {n:int}{fe:eff}
(
  A: !arrayptr(INV(a), n), asz: size_t(n), fwork: (&a) -<fun,fe> void
) :<fe> void // end of [arrayptr_foreach_fun]

fun
{a:vt0p}
arrayptr_foreach_funenv
  {v:view}
  {vt:vtype}
  {n:int}
  {fe:eff}
(
  pfv: !v
| A: !arrayptr(INV(a), n)
, asz: size_t(n)
, fop: (!v | &a, !vt) -<fun,fe> void
, env: !vt
) :<fe> void
// end of [arrayptr_foreach_funenv]

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

(*
fun{a:vt0p}{env:vt0p}
array_iforeach$cont (i: size_t, x: &a, env: &env): void
fun{a:vt0p}{env:vt0p}
array_iforeach$fwork (i: size_t, x: &a >> a, env: &(env) >> _): void
*)
fun{
a:vt0p
} arrayptr_iforeach{n:int}
(
  A: !arrayptr(INV(a), n), asz: size_t(n)
) : sizeLte(n) // end of [arrayptr_iforeach]
fun{
a:vt0p}{env:vt0p
} arrayptr_iforeach_env{n:int}
(
  A: !arrayptr(INV(a), n), asz: size_t(n), env: &(env) >> _
) : sizeLte(n) // end of [arrayptr_iforeach_env]

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

(*
fun{a:vt0p}{env:vt0p}
array_rforeach$cont (x: &a, env: &env): void
fun{a:vt0p}{env:vt0p}
array_rforeach$fwork (x: &a >> a, env: &(env) >> _): void
*)
fun{
a:vt0p
} arrayptr_rforeach{n:int}
(
  A: !arrayptr(INV(a), n), asz: size_t(n)
) : sizeLte(n) // end of [arrayptr_rforeach]
fun{
a:vt0p}{env:vt0p
} arrayptr_rforeach_env{n:int}
(
  A: !arrayptr(INV(a), n), asz: size_t(n), env: &(env) >> _
) : sizeLte(n) // end of [arrayptr_rforeach_env]

(* ****** ****** *)
//
(*
fun{a:vt0p}
array_initize$init (i: size_t, x: &a >> a?): void
*)
//
fun{a:vt0p}
arrayptr_initize
  {l:addr}{n:int}
(
  A: !arrayptr(a?, l, n) >> arrayptr(a, l, n), asz: size_t(n)
) : void // end of [arrayptr_initize]
//
macdef
arrayptr_initialize = arrayptr_initize
//
(* ****** ****** *)
//
(*
fun{a:vt0p}
array_uninitize$clear (i: size_t, x: &a >> a?): void
*)
fun{a:vt0p}
arrayptr_uninitize
  {l:addr}{n:int}
(
  A: !arrayptr(INV(a), l, n) >> arrayptr(a?, l, n), asz: size_t(n)
) : void // end of [arrayptr_uninitize]
//
macdef
arrayptr_uninitialize = arrayptr_uninitize
//
(* ****** ****** *)

(*
fun{a:vt0p}
array_uninitize$clear (i: size_t, x: &a >> a?): void
*)
fun{a:vt0p}
arrayptr_freelin
  {l:addr}{n:int}
  (A: arrayptr(INV(a), l, n), asz: size_t(n)): void
// end of [arrayptr_freelin]

(* ****** ****** *)
//
(*
fun{a:vt0p}
array_tabulate$fopr (index: size_t): (a)
*)
fun{a:vt0p}
arrayptr_tabulate
  {n:int} (asz: size_t(n)): arrayptr(a, n)
//
fun{a:vt0p}
arrayptr_tabulate_cloref
  {n:int}
  (size_t(n), (sizeLt(n)) -<cloref> a): arrayptr(a, n)
//
(* ****** ****** *)
//
fun
{a:vt0p}
arrayptr_quicksort
  {n:int}(A: !arrayptr(a, n) >> _, asz: size_t(n)): void
//
(* ****** ****** *)
//
// overloading for certain symbols
//
(* ****** ****** *)

overload [] with arrayptr_get_at_gint of 0
overload [] with arrayptr_set_at_gint of 0
overload [] with arrayptr_get_at_guint of 0
overload [] with arrayptr_set_at_guint of 0

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

overload free with arrayptr_free

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

overload fprint with fprint_arrayptr
overload fprint with fprint_arrayptr_sep

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

overload ptrcast with arrayptr2ptr
overload ptrcast with arrayptrout2ptr

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

(* end of [arrayptr.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/arrayref.atxt
** Time of generation: Tue Aug 29 08:31:46 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: February, 2012 *)

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

#define NSH (x) x // for commenting: no sharing
#define SHR (x) x // for commenting: it is shared

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

sortdef tk = tkind

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

sortdef t0p = t@ype and vt0p = viewt@ype

(* ****** ****** *)
//
// arrayref:
// reference to an array without size attached 
//
(* ****** ****** *)

#if(0)
//
// HX-2013-06:
// it is declared in [basic_dyn.sats]
//
abstype
arrayref_vt0ype_int_type
  (a: vt@ype(*elt*), n: int(*size*)) = ptr
stadef arrayref = arrayref_vt0ype_int_type
#endif

(* ****** ****** *)
//
praxi
lemma_arrayref_param
  {a:vt0p}{n:int}
  (A0: arrayref(a, n)): [n >= 0] void
//
(* ****** ****** *)
//
castfn
arrayref2ptr
  {a:vt0p}{n:int}(A: arrayref(a, n)):<> Ptr0
//
(* ****** ****** *)
//
(*
**
** HX-2012-06:
**
** this function essentially passes the proof of
** array-view to GC (leaks it if GC is unavailable)
*)
//
castfn
arrayptr_refize
  {a:vt0p}
  {l:addr}{n:int}
(
  A0:
  arrayptr(INV(a), l, n)
) :<!wrt> arrayref(a, n)
//
castfn
arrayref_get_viewptr
  {a:vt0p}{n:int}
(
  A0: arrayref(a, n)
) :<>
[
  l:addr
] (
  vbox(array_v(a, l, n)) | ptr(l)
) (* end of [arrayref_get_viewptr] *)
//
(* ****** ****** *)
//
fun
arrayref_make_arrpsz
  {a:vt0p}{n:int}
(
  arrpsz(INV(a), n)
) :<!wrt> arrayref(a, n) = "mac#%"
//
symintr arrayref
//
overload
arrayref with arrayref_make_arrpsz
//
(* ****** ****** *)
//
fun
{a:t0p}
arrayref_make_elt
  {n:int}
(
  asz: size_t(n), x0: a
) :<!wrt> arrayref(a, n)
// end of [arrayref_make_elt]
//
(* ****** ****** *)
//
fun{}
arrayref_make_intrange
  {l,r:int | l <= r}
(
  l: int l, r: int r
) :<!wrt> arrayref(int, r-l)
// end of [arrayref_make_intrange]
//
(* ****** ****** *)
//
fun
{a:t0p}
arrayref_make_list
  {n:int}
(
  asz: int n, xs: list(INV(a), n)
) :<!wrt> arrayref(a, n)
// end of [arrayref_make_list]
//
fun
{a:t0p}
arrayref_make_rlist
  {n:int}
(
  asz: int n, xs: list(INV(a), n)
) :<!wrt> arrayref(a, n)
// end of [arrayref_make_rlist]
//
(* ****** ****** *)
//
// HX-2014-02:
// [A] must survive [arrayref_tail(A)]
// in order to support proper garbage-collection
//
fun
{a:t0p}
arrayref_head
  {n:pos} (A: arrayref(a, n)):<!ref> (a) // A[0]
fun
{a:t0p}
arrayref_tail
  {n:pos} (A: arrayref(a, n)):<!ref> arrayref(a, n-1)
//
(* ****** ****** *)
//
fun{
a:t0p}{tk:tk
} arrayref_get_at_gint
  {n:int}{i:nat | i < n}
(
A0: arrayref(a, n), i: g1int(tk, i)
) :<!ref> (a) // arrayref_get_at_gint
//
fun{
a:t0p}{tk:tk
} arrayref_get_at_guint
  {n:int}{i:nat | i < n}
(
A0: arrayref(a, n), i: g1uint(tk, i)
) :<!ref> (a) // arrayref_get_at_guint
//
symintr
arrayref_get_at
//
overload
arrayref_get_at with arrayref_get_at_gint of 0
overload
arrayref_get_at with arrayref_get_at_guint of 0
//
(* ****** ****** *)
//
fun{
a:t0p}{tk:tk
} arrayref_set_at_gint
  {n:int}{i:nat | i < n} (
  A: arrayref(a, n), i: g1int(tk, i), x: a
) :<!refwrt> void // end of [arrayref_set_at_gint]
//
fun{
a:t0p}{tk:tk
} arrayref_set_at_guint
  {n:int}{i:nat | i < n} (
  A: arrayref(a, n), i: g1uint(tk, i), x: a
) :<!refwrt> void // end of [arrayref_set_at_guint]
//
symintr
arrayref_set_at
//
overload
arrayref_set_at with arrayref_set_at_gint of 0
overload
arrayref_set_at with arrayref_set_at_guint of 0
//
(* ****** ****** *)

fun{
a:vt0p}{tk:tk
} arrayref_exch_at_gint
  {n:int}{i:nat | i < n}
(
A0: arrayref(a, n), i: g1int(tk, i), x: &a >> _
) :<!refwrt> void // arrayref_exch_at_gint

fun{
a:vt0p}{tk:tk
} arrayref_exch_at_guint
  {n:int}{i:nat | i < n}
(
A0: arrayref(a, n), i: g1uint(tk, i), x: &a >> _
) :<!refwrt> void // arrayref_exch_at_guint
//
symintr
arrayref_exch_at
//
overload
arrayref_exch_at with arrayref_exch_at_gint of 0
overload
arrayref_exch_at with arrayref_exch_at_guint of 0
//
(* ****** ****** *)
//
fun{a:vt0p}
arrayref_interchange
  {n:int}
(
  A: arrayref(a, n), i: sizeLt(n), j: sizeLt(n)
) :<!refwrt> void // end-of-function
//
(* ****** ****** *)

fun{a:vt0p}
arrayref_subcirculate
  {n:int}
(
  A: arrayref(a, n), i: sizeLt(n), j: sizeLt(n)
) :<!refwrt> void // end-of-function

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

(*
fun{}
fprint_array$sep
  (out: FILEref): void
*)
fun{a:vt0p}
fprint_arrayref
  {n:int}
(
  FILEref
, arrayref(a, n), asz: size_t(n)
) : void // end of [fprint_arrayref]
fun{a:vt0p}
fprint_arrayref_sep
  {n:int}
( FILEref
, arrayref(a, n), asz: size_t(n), sep: NSH(string)
) : void // end of [fprint_arrayref_sep]

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

fun{a:t0p}
arrayref_copy{n:int}
  (A: arrayref(a, n), n: size_t(n)): arrayptr(a, n)
// end of [arrayref_copy]

(* ****** ****** *)
//
(*
fun{a:vt0p}
array_tabulate$fopr(index: size_t): (a)
*)
fun{a:vt0p}
arrayref_tabulate
  {n:int}(asz: size_t(n)): arrayref(a, n)
//
fun{a:vt0p}
arrayref_tabulate_cloref
  {n:int}
(
  asz: size_t(n), fopr: (sizeLt(n)) -<cloref> (a)
) : arrayref(a, n) // end-of-function
//
(* ****** ****** *)

(*
fun
{a:vt0p}
{env:vt0p}
array_foreach$cont
  (x: &a, env: &env): void
fun
{a:vt0p}
{env:vt0p}
array_foreach$fwork
  (x: &a >> a, env: &(env) >> _): void
*)
fun
{a:vt0p}
arrayref_foreach{n:int}
(
A0: arrayref(a, n), asz: size_t(n)
) : sizeLte(n) // end of [arrayref_foreach]
fun
{a:vt0p}
{env:vt0p}
arrayref_foreach_env{n:int}
(
A0: arrayref(a, n), asz: size_t(n), env: &env >> _
) : sizeLte(n) // end of [arrayref_foreach_env]

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

(*
fun
{a:vt0p}
{env:vt0p}
array_iforeach$cont
  (i: size_t, x: &a, env: &env): void
fun
{a:vt0p}
{env:vt0p}
array_iforeach$fwork
  (i: size_t, x: &a >> a, env: &(env) >> _): void
*)
fun
{a:vt0p}
arrayref_iforeach{n:int}
(
  A: arrayref(a, n), asz: size_t(n)
) : sizeLte(n) // end of [arrayref_iforeach]
fun
{a:vt0p}
{env:vt0p}
arrayref_iforeach_env{n:int}
(
  A: arrayref(a, n), asz: size_t(n), env: &(env) >> _
) : sizeLte(n) // end of [arrayref_iforeach_env]

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

(*
fun{a:vt0p}{env:vt0p}
array_rforeach$cont (x: &a, env: &env): void
fun{a:vt0p}{env:vt0p}
array_rforeach$fwork (x: &a >> a, env: &(env) >> _): void
*)
fun{
a:vt0p
} arrayref_rforeach{n:int}
(
  A: arrayref(a, n), asz: size_t(n)
) : sizeLte(n) // end of [arrayref_rforeach]
fun{
a:vt0p}{env:vt0p
} arrayref_rforeach_env{n:int}
(
  A: arrayref(a, n), asz: size_t(n), env: &(env)>>env
) : sizeLte(n) // end of [arrayref_rforeach_env]

(* ****** ****** *)
//
// HX-2017-02-19:
// Using [gcompare_ref_ref] to check
//
fun
{a:vt0p}
arrayref_is_ordered
  {n:int}(A: arrayref(a, n), asz: size_t(n)): bool
//
(* ****** ****** *)
//
fun
{a:vt0p}
arrayref_quicksort
  {n:int}(A: arrayref(a, n), asz: size_t(n)): void
//
fun
{a:vt0p}
arrayref_quicksort_stdlib
  {n:int}
  (A: arrayref(a, n), asz: size_t(n), cmp: cmpref(a)): void
//
(* ****** ****** *)
(*
//
// HX: see below
//
fun
{a:t0p}
streamize_arrayref_elt
  {n:int}
  (A: arrayref(a, n), asz: size_t(n)):<!wrt> stream_vt(a)
*)
(* ****** ****** *)
//
// arrszref:
// reference to an array with its size attached
//
(* ****** ****** *)

#if(0)
//
// HX-2013-06:
// it is declared in [basic_dyn.sats]
//
abstype
arrszref_vt0ype_type (a: vt@ype) = ptr
stadef arrszref = arrszref_vt0ype_type
//
#endif

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

symintr arrszref

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

fun{}
arrszref_make_arrpsz
  {a:vt0p}{n:int}
  (arrpsz (INV(a), n)):<!wrt> arrszref(a)
//
overload arrszref with arrszref_make_arrpsz
//
(* ****** ****** *)

fun{}
arrszref_make_arrayref
  {a:vt0p}{n:int}
  (A: SHR(arrayref(a, n)), n: size_t(n)):<!wrt> arrszref(a)
// end of [arrszref_make_arrayref]

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

fun{
} arrszref_get_ref{a:vt0p} (A: arrszref(a)):<> Ptr1
fun{
} arrszref_get_size{a:vt0p} (A: arrszref(a)):<> size_t

(* ****** ****** *)
//
fun{}
arrszref_get_refsize{a:vt0p}
(
  A: arrszref(a), asz: &size_t? >> size_t(n)
) :<!wrt> #[n:nat] arrayref(a, n) // end-of-fun
//
(* ****** ****** *)

fun{a:t0p}
arrszref_make_elt(asz: size_t, x: a):<!wrt> arrszref(a)
// end of [arrszref_make_elt]

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

fun{a:t0p}
arrszref_make_list(xs: List(INV(a))):<!wrt> arrszref(a)
// end of [arrszref_make_list]

fun{a:t0p}
arrszref_make_rlist(xs: List(INV(a))):<!wrt> arrszref(a)
// end of [arrszref_make_rlist]

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

(*
fun{}
fprint_array$sep(out: FILEref): void
*)
fun{a:vt0p}
fprint_arrszref
  (out: FILEref, A: arrszref(a)): void
// end of [fprint_arrszref]
fun{a:vt0p}
fprint_arrszref_sep
(
  out: FILEref, A: arrszref(a), sep: NSH(string)
) : void // end of [fprint_arrszref_sep]

(* ****** ****** *)
//
fun{a:t0p}
arrszref_get_at_size
  (A: arrszref(a), i: size_t):<!exnref> a
//
fun{
a:t0p}{tk:tk
} arrszref_get_at_gint
  (A: arrszref(a), i: g0int(tk)):<!exnref> a
//
fun{
a:t0p}{tk:tk
} arrszref_get_at_guint
  (A: arrszref(a), i: g0uint(tk)):<!exnref> a
//
symintr
arrszref_get_at
overload
arrszref_get_at with arrszref_get_at_gint of 0
overload
arrszref_get_at with arrszref_get_at_guint of 0
//
(* ****** ****** *)
//
fun
{a:t0p}
arrszref_set_at_size
  (A: arrszref(a), i: size_t, x: a):<!exnrefwrt> void
//
fun{
a:t0p}{tk:tk
} arrszref_set_at_gint
  (A: arrszref(a), i: g0int(tk), x: a):<!exnrefwrt> void
//
fun{
a:t0p}{tk:tk
} arrszref_set_at_guint
  (A: arrszref(a), i: g0uint(tk), x: a):<!exnrefwrt> void
//
symintr
arrszref_set_at
//
overload
arrszref_set_at with arrszref_set_at_gint of 0
overload
arrszref_set_at with arrszref_set_at_guint of 0
//
(* ****** ****** *)
//
fun
{a:vt0p}
arrszref_exch_at_size
(
A0: arrszref(a), i: size_t, x: &a >> _
) :<!exnrefwrt> void
//
fun{
a:vt0p
}{tk:tk}
arrszref_exch_at_gint
(
A0: arrszref(a), i: g0int(tk), x: &a >> _
) :<!exnrefwrt> void // end-of-function
//
fun{
a:vt0p
}{tk:tk}
arrszref_exch_at_guint
(
A0: arrszref(a), i: g0uint(tk), x: &a >> _
) :<!exnrefwrt> void // end-of-function
//
symintr
arrszref_exch_at
//
overload
arrszref_exch_at with arrszref_exch_at_gint of 0
overload
arrszref_exch_at with arrszref_exch_at_guint of 0

(* ****** ****** *)
//
fun
{a:vt0p}
arrszref_interchange
  (A: arrszref(a), i: size_t, j: size_t):<!exnrefwrt> void
// end of [arrszref_interchange]
//
(* ****** ****** *)
//
fun
{a:vt0p}
arrszref_subcirculate
  (A: arrszref(a), i: size_t, j: size_t):<!exnrefwrt> void
// end of [arrszref_subcirculate]
//
(* ****** ****** *)
//
(*
fun{a:vt0p}
array_tabulate$fopr(size_t): (a)
*)
fun{a:vt0p}
arrszref_tabulate(asz: size_t): arrszref(a)
//
fun{a:vt0p}
arrszref_tabulate_cloref
  {n:int}
  (size_t(n), (sizeLt(n)) -<cloref> a): arrszref(a)
//
(* ****** ****** *)
//
// HX: for streamization of arrays
//
(* ****** ****** *)
//
fun
{a:t0p}
streamize_arrszref_elt
  (ASZ: arrszref(a)): stream_vt(a)
fun
{a:t0p}
streamize_arrayref_elt
  {n:int}(A: arrayref(a, n), n: size_t(n)): stream_vt(a)
//
(* ****** ****** *)
//
// overloading for certain symbols
//
(* ****** ****** *)
//
overload [] with arrayref_get_at_gint of 0
overload [] with arrayref_set_at_gint of 0
overload [] with arrszref_get_at_gint of 0
overload [] with arrszref_set_at_gint of 0
//
overload [] with arrayref_get_at_guint of 0
overload [] with arrayref_set_at_guint of 0
overload [] with arrszref_get_at_guint of 0
overload [] with arrszref_set_at_guint of 0
//
(* ****** ****** *)

overload .head with arrayref_head
overload .tail with arrayref_tail

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

overload size with arrszref_get_size
overload .size with arrszref_get_size

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

overload fprint with fprint_arrayref
overload fprint with fprint_arrayref_sep
overload fprint with fprint_arrszref
overload fprint with fprint_arrszref_sep

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

overload ptrcast with arrayref2ptr

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

(* end of [arrayref.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/matrix.atxt
** Time of generation: Fri Aug 18 03:29:54 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: Feburary, 2012 *)

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

vtypedef
RD(a:vt0p) = a // for commenting: read-only
#define NSH (x) x // for commenting: no sharing
#define SHR (x) x // for commenting: it is shared

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

sortdef t0p = t@ype
sortdef vtp = viewtype
sortdef vt0p = viewt@ype

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

absvt@ype
matrix_vt0ype_int_int_vt0ype
  (a:vt@ype+, row:int, col:int) = array(a, row*col)
stadef matrix = matrix_vt0ype_int_int_vt0ype

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

viewdef
matrix_v (
  a:viewt@ype+, l:addr, row:int, col:int
) = matrix (a, row, col) @ l

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

exception
MatrixSubscriptExn of ((*void*))

(* ****** ****** *)
//
praxi
lemma_matrix_param
  {a:vt0p}
  {l:addr}{m,n:int}
(
  M: &matrix(INV(a), m, n)
) : [m >= 0; n >= 0] void
//
praxi
lemma_matrix_v_param
  {a:vt0p}
  {l:addr}{m,n:int}
(
  pf0: !matrix_v(INV(a), l, m, n)
) : [m >= 0; n >= 0] void // end-of-fun
//
(* ****** ****** *)
//
praxi
array2matrix_v
  {a:vt0p}
  {l:addr}{m,n:int}
(
  pf0:
  array_v(INV(a), l, m*n)
) : matrix_v (a, l, m(*nrow*), n(*ncol*))
praxi
matrix2array_v
  {a:vt0p}
  {l:addr}{m,n:int}
  (pf0: matrix_v(INV(a), l, m, n)): array_v (a, l, m*n)
//
(* ****** ****** *)
//
// HX: row-major style
//
absview
matrow_view
(
  a:vt@ype+
, l:addr, m:int, n:int
)
//
stadef matrow_v = matrow_view
//
absview
matcol_view
(
  a:vt@ype+
, l:addr, m:int, n:int
)
//
stadef matcol_v = matcol_view
//
(* ****** ****** *)
//
fun{a:vt0p}
matrix_getref_at_int
  {m,n:int}
(
  M: &RD(matrix(INV(a), m, n))
, i: natLt (m), n: int n, j: natLt (n)
) :<> cPtr1 (a) // end-of-function
//
fun{a:vt0p}
matrix_getref_at_size
  {m,n:int}
(
  M: &RD(matrix(INV(a), m, n))
, i: sizeLt (m), n: size_t n, j: sizeLt (n)
) :<> cPtr1 (a) // end-of-function
//
symintr matrix_getref_at
//
overload
matrix_getref_at with matrix_getref_at_int
overload
matrix_getref_at with matrix_getref_at_size
//
(* ****** ****** *)
//
fun{a:t0p}
matrix_get_at_int
  {m,n:int}
(
  M: &RD(matrix(INV(a), m, n))
, i: natLt (m), n: int n, j: natLt (n)
) :<> (a) // end-of-function
//
overload [] with matrix_get_at_int
//
fun{a:t0p}
matrix_get_at_size
  {m,n:int}
(
  M: &RD(matrix(INV(a), m, n))
, i: sizeLt (m), n: size_t n, j: sizeLt(n)
) :<> (a) // endfun
//
overload [] with matrix_get_at_size
//
symintr matrix_get_at
//
overload
matrix_get_at with matrix_get_at_int of 0
overload
matrix_get_at with matrix_get_at_size of 0
//
(* ****** ****** *)
//
fun{a:t0p}
matrix_set_at_int
  {m,n:int}
(
  M: &matrix(INV(a), m, n)
, i: natLt (m), n: int n, j: natLt (n), x: a
) :<!wrt> void // end-of-function
//
overload [] with matrix_set_at_int
//
fun{a:t0p}
matrix_set_at_size
  {m,n:int}
(
  M: &matrix(INV(a), m, n)
, i: sizeLt (m), n: size_t n, j: sizeLt (n), x: a
) :<!wrt> void // end-of-function
//
overload [] with matrix_set_at_size
//
symintr matrix_set_at
//
overload
matrix_set_at with matrix_set_at_int of 0
overload
matrix_set_at with matrix_set_at_size of 0
//
(* ****** ****** *)

fun{a:vt0p}
matrix_exch_at_int
  {m,n:int}
(
  M: &matrix(INV(a), m, n)
, i: natLt (m), n: int n, j: natLt (n), x: &a>>a
) :<!wrt> void // endfun

fun{a:vt0p}
matrix_exch_at_size
  {m,n:int}
(
  M: &matrix(INV(a), m, n)
, i: sizeLt (m), n: size_t n, j: sizeLt (n), x: &a>>a
) :<!wrt> void // endfun

symintr matrix_exch_at
overload matrix_exch_at with matrix_exch_at_int
overload matrix_exch_at with matrix_exch_at_size

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

fun{a:vt0p}
matrix_ptr_alloc
  {m,n:int}
(
  row: size_t m, col: size_t n
) :<!wrt> [l:agz]
(
  matrix_v(a?, l, m, n), mfree_gc_v (l) | ptr l
) // end of [matrix_ptr_alloc]

fun{}
matrix_ptr_free
  {a:vt0p}{l:addr}{m,n:int}
(
  matrix_v(a?, l, m, n), mfree_gc_v l | ptr l
) :<!wrt> void // end of [matrix_ptr_free]

(* ****** ****** *)
//
fun{a:vt0p}
matrix_tabulate$fopr
  (i: size_t, j: size_t): (a)
//
fun{a:vt0p}
matrix_ptr_tabulate
  {m,n:int}
(
  nrow: size_t m, ncol: size_t n
) : [l:addr]
(
  matrix_v (a, l, m, n), mfree_gc_v (l) | ptr(l)
) (* end of [matrixptr_tabulate] *)
//
(* ****** ****** *)
//
fun{}
fprint_matrix$sep1(out: FILEref): void // col sep
fun{}
fprint_matrix$sep2(out: FILEref): void // row sep
//
fun{a:vt0p}
fprint_matrix_int
  {m,n:int}
(
  out: FILEref
, mat: &matrix(INV(a), m, n), m: int(m), n: int(n)
) : void // end of [fprint_matrix_int]
fun{a:vt0p}
fprint_matrix_size
  {m,n:int}
(
  out: FILEref
, mat: &matrix(INV(a), m, n), m: size_t(m), n: size_t(n)
) : void // end of [fprint_matrix_size]
//
symintr fprint_matrix
//
overload fprint_matrix with fprint_matrix_int
overload fprint_matrix with fprint_matrix_size
//
(* ****** ****** *)

fun{a:vt0p}
fprint_matrix_sep
  {m,n:int}
(
  out: FILEref
, M: &matrix(INV(a), m, n)
, m: size_t(m), n: size_t(n)
, sep1: NSH(string), sep2: NSH(string)
) : void // end of [fprint_matrix_sep]

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

fun{a:vt0p}
matrix_ptr_takeout_elt
  {l0:addr}
  {m,n:int}
  {i,j:nat | i < m; j < n}
(
  pfm: matrix_v(INV(a), l0, m, n)
| base: ptr(l0)
, i: size_t(i), n: size_t(n), j: size_t(j)
) :<>
[l:addr]
(
  a @ l
, a @ l -<lin,prf> matrix_v (a, l0, m, n)
| ptr (l)
) (* end of [matrix_ptr_takeout_elt] *)

fun{a:vt0p}
matrix_ptr_takeout_row
  {l0:addr}
  {m,n:int}
  {i:int | i < m}
(
  pfm: matrix_v(INV(a), l0, m, n)
| base: ptr(l0), i: size_t(i), n: size_t(n)
) :<>
[l:addr]
(
  matrow_v(a, l, m, n)
, matrow_v(a, l, m, n) -<lin,prf> matrix_v(a, l0, m, n)
| ptr (l)
) (* end of [matrix_ptr_takeout_row] *)

fun{a:vt0p}
matrix_ptr_takeout_col
  {l0:addr}
  {m,n:int}
  {i:int | i < m}
(
  pfm: matrix_v(INV(a), l0, m, n)
| base: ptr l0, i: size_t(i), n: size_t(n)
) :<>
[l:addr]
(
  matcol_v(a, l, m, n)
, matcol_v(a, l, m, n) -<lin,prf> matrix_v(a, l0, m, n)
| ptr (l)
) (* end of [matrix_ptr_takeout_col] *)

(* ****** ****** *)
//
fun{}
matrix_foreach$rowsep(): void
fun{
a:vt0p}{env:vt0p
} matrix_foreach$fwork
  (x: &a >> _, env: &(env) >> _): void
fun{
a:vt0p
} matrix_foreach{m,n:int}
(
  M: &matrix(INV(a), m, n) >> _, size_t(m), size_t(n)
) : void // end of [matrix_foreach]
fun{
a:vt0p}{env:vt0p
} matrix_foreach_env{m,n:int}
(
  M: &matrix(INV(a), m, n) >> _, size_t(m), size_t(n), env: &(env) >> _
) : void // end of [matrix_foreach_env]
//
(* ****** ****** *)
//
fun{
a:vt0p}{env:vt0p
} matrix_foreachrow$fwork
  {n:int}
(
  A: &array(INV(a), n) >> _, n: size_t(n), env: &(env) >> _
) : void // end of [matrix_foreachrow$fwork]
//
fun{
a:vt0p
} matrix_foreachrow{m,n:int}
(
  M: &matrix(INV(a), m, n) >> _, m: size_t(m), n: size_t(n)
) : void // end of [matrix_foreachrow]
//
fun{
a:vt0p}{env:vt0p
} matrix_foreachrow_env{m,n:int}
(
  M: &matrix(INV(a), m, n) >> _, m: size_t(m), n: size_t(n), env: &(env) >> _
) : void // end of [matrix_foreachrow_env]
//
(* ****** ****** *)
//
fun{a:vt0p}
matrix_initize$init
  (i: size_t, j: size_t, x: &a? >> a): void
//
fun{a:vt0p}
matrix_initize{m,n:int}
(
  M: &matrix(a?, m, n) >> matrix(a, m, n), m: size_t(m), n: size_t(n)
) : void // end of [matrix_initize]
//
macdef matrix_initialize = matrix_initize
//
(* ****** ****** *)
//
fun{a:vt0p}
matrix_uninitize$clear
  (i: size_t, j: size_t, x: &a >> a?): void
//
fun{a:vt0p}
matrix_uninitize{m,n:int}
(
  M: &matrix(a, m, n) >> matrix(a?, m, n), m: size_t(m), n: size_t(n)
) : void // end of [matrix_uninitize]
//
(* ****** ****** *)

fun
{a:vt0p}
{b:vt0p}
matrix_mapto$fwork
  (x: &a, y: &b? >> b): void
fun
{a:vt0p}
{b:vt0p}
matrix_mapto
  {m,n:int}
(
  A: &matrix(INV(a), m, n)
, B: &matrix(b?, m, n) >> matrix(b, m, n)
, m: size_t m, n: size_t n
) : void // end of [matrix_mapto]

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

fun
{a,b:vt0p}
{c:vt0p}
matrix_map2to$fwork
  (x: &a, y: &b, z: &c? >> c): void
fun
{a,b:vt0p}
{c:vt0p}
matrix_map2to
  {m,n:int}
(
  A: &matrix(INV(a), m, n)
, B: &matrix(INV(b),  m, n)
, C: &matrix(c?, m, n) >> matrix(c, m, n)
, m: size_t m, n: size_t n
) : void // end of [matrix_map2to]

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

(* end of [matrix.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/matrixptr.atxt
** Time of generation: Fri Aug 18 03:29:55 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: February, 2012 *)

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

typedef SHR(a:type) = a // for commenting purpose
typedef NSH(a:type) = a // for commenting purpose

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

sortdef t0p = t@ype and vt0p = viewt@ype

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

absvtype
matrixptr_vt0ype_addr_int_int_vtype
  (a:vt@ype+, l: addr, m: int, n: int) = ptr
//
stadef
matrixptr = matrixptr_vt0ype_addr_int_int_vtype
vtypedef
matrixptr
  (a:vt@ype, m: int, n: int) = [l:addr] matrixptr(a, l, m, n)
//
(* ****** ****** *)

absvtype
matrixptrout_vt0ype_addr_int_int_vtype
  (a:vt@ype, l: addr, m: int, n: int) = ptr
//
stadef
matrixptrout = matrixptrout_vt0ype_addr_int_int_vtype
//
(* ****** ****** *)

praxi
lemma_matrixptr_param{a:vt0p}
  {l:addr}{m,n:int} (A: !matrixptr(a, l, m, n)): [m >= 0; n >= 0] void
// end of [lemma_matrixptr_param]

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

castfn
matrixptr_encode :
  {a:vt0p}{l:addr}{m,n:int}
  (matrix_v(INV(a), l, m, n), mfree_gc_v(l) | ptr l) -<0> matrixptr(a, l, m, n)
// end of [matrixptr_encode]

castfn
matrixptr_encode2 :
  {a:vt0p}{l:addr}{m,n:int}
  @(matrix_v(INV(a), l, m, n), mfree_gc_v(l) | ptr l) -<0> matrixptr(a, l, m, n)
// end of [matrixptr_encode2]

(* ****** ****** *)
//
castfn
matrixptr2ptr
  {a:vt0p}
  {l:addr}{m,n:int}
  (A: !matrixptr(INV(a), l, m, n)):<> ptr(l)
//
castfn
matrixptrout2ptr
  {a:t0p}
  {l:addr}{m,n:int}
  (A: !matrixptrout(INV(a), l, m, n)):<> ptr(l)
//
(* ****** ****** *)

praxi
matrixptr_takeout
  {a:vt0p}{l:addr}{m,n:int}
(
  !matrixptr(INV(a), l, m, n) >> matrixptrout(a?, l, m, n)
) : matrix_v(a, l, m, n) // endfun
praxi
matrixptr_addback
  {a:vt0p}{l:addr}{m,n:int}
(
  pf: matrix_v(INV(a), l, m, n)
| mat: !matrixptrout(a?, l, m, n) >> matrixptr(a, l, m, n)
) : void // end of [matrixptr_addback]

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

fun{
} arrayptr2matrixptr_int
  {a:vt0p}{l:addr}{m,n:nat}
  (A: arrayptr(INV(a), l, m*n), m: int m, n: int n):<> matrixptr(a, l, m, n)
fun{
} arrayptr2matrixptr_size
  {a:vt0p}{l:addr}{m,n:int}
  (A: arrayptr(INV(a), l, m*n), m: size_t m, n: size_t n):<> matrixptr(a, l, m, n)
//
symintr arrayptr2matrixptr
overload arrayptr2matrixptr with arrayptr2matrixptr_int
overload arrayptr2matrixptr with arrayptr2matrixptr_size
//
(* ****** ****** *)

fun{
a:t0p
} matrixptr_make_elt
  {m,n:int}
  (m: size_t m, n: size_t n, x: a):<!wrt> matrixptr(a, m, n)
// end of [matrixptr_make_elt]

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

fun{a:t0p}
matrixptr_get_at_int
  {m,n:int}
(
  A: !matrixptr(INV(a), m, n), i: natLt (m), n: int n, j: natLt (n)
) :<> (a) // end of [matrixptr_get_at_int]
fun{a:t0p}
matrixptr_get_at_size
  {m,n:int}
(
  A: !matrixptr(INV(a), m, n), i: sizeLt (m), n: size_t n, j: sizeLt (n)
) :<> (a) // end of [matrixptr_get_at_size]
//
symintr matrixptr_get_at
overload matrixptr_get_at with matrixptr_get_at_int of 0
overload matrixptr_get_at with matrixptr_get_at_size of 0
//
(* ****** ****** *)

fun{a:t0p}
matrixptr_set_at_int
  {m,n:int}
(
  A: !matrixptr(INV(a), m, n), i: natLt (m), n: int n, j: natLt (n), x: a
) :<!wrt> void // end of [matrixptr_set_at_int]
fun{a:t0p}
matrixptr_set_at_size
  {m,n:int}
(
  A: !matrixptr(INV(a), m, n), i: sizeLt (m), n: size_t n, j: sizeLt (n), x: a
) :<!wrt> void // end of [matrixptr_set_at_size]
//
symintr matrixptr_set_at
overload matrixptr_set_at with matrixptr_set_at_int of 0
overload matrixptr_set_at with matrixptr_set_at_size of 0
//
(* ****** ****** *)

fun{a:vt0p}
matrixptr_exch_at_int
  {m,n:int}
(
  A: !matrixptr(INV(a), m, n)
, i: natLt (m), n: int n, j: natLt (n), x: &a>>a
) :<!wrt> void // end of [matrixptr_exch_at_int]
fun{a:vt0p}
matrixptr_exch_at_size
  {m,n:int}
(
  A: !matrixptr(INV(a), m, n)
, i: sizeLt (m), n: size_t n, j: sizeLt (n), x: &a>>a
) :<!wrt> void // end of [matrixptr_exch_at_size]
//
symintr matrixptr_exch_at
overload matrixptr_exch_at with matrixptr_exch_at_int
overload matrixptr_exch_at with matrixptr_exch_at_size
//
(* ****** ****** *)

fun matrixptr_free
  {a:t0p}{l:addr}{m,n:int}
  (A: matrixptr(INV(a), l, m, n)):<!wrt> void = "mac#%"
// end of [matrixptr_free]

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

(*
fprint_matrix$sep1 // col separation
fprint_matrix$sep2 // row separation
*)
fun{a:vt0p}
fprint_matrixptr{m,n:int}
(
  out: FILEref
, M: !matrixptr(INV(a), m, n), m: size_t m, n: size_t n
) : void // end of [fprint_matrixptr]

fun{a:vt0p}
fprint_matrixptr_sep{m,n:int}
(
  out: FILEref
, M: !matrixptr(INV(a), m, n), m: size_t (m), n: size_t (n)
, sep1: NSH(string), sep2: NSH(string)
) : void // end of [fprint_matrixptr_sep]

(* ****** ****** *)
//
(*
fun{a:vt0p}
matrix_initize$init (i: size_t, x: &a >> a?): void
*)
fun{a:vt0p}
matrixptr_initize
  {l:addr}{m,n:int}
(
  M: !matrixptr(a?, l, m, n) >> matrixptr(a, l, m, n), m: size_t(m), n: size_t(n)
) : void // end of [matrixptr_initize]
//
macdef
matrixptr_initialize = matrixptr_initize
//
(* ****** ****** *)
//
(*
fun{a:vt0p}
matrix_uninitize$clear
  (i: size_t, j: size_t, x: &a >> a?): void
*)
fun{a:vt0p}
matrixptr_uninitize
  {l:addr}{m,n:int}
(
  M: !matrixptr(INV(a), l, m, n) >> matrixptr(a?, l, m, n), m: size_t(m), n: size_t(n)
) : void // end of [matrixptr_uninitize]
//
macdef
matrixptr_uninitialize = matrixptr_uninitize
//
(* ****** ****** *)
//
(*
fun{a:vt0p}
matrix_uninitize$clear
  (i: size_t, j: size_t, x: &a >> a?): void
*)
fun{
a:vt0p
} matrixptr_freelin
  {l:addr}{m,n:int}
(
  A: matrixptr(INV(a), l, m, n), m: size_t(m), n: size_t(n)
) : void = "mac#%" // end-of-function
//
(* ****** ****** *)
//
(*
fun{a:vt0p}
matrix_tabulate$fopr (i: size_t, j: size_t): (a)
*)
fun{a:vt0p}
matrixptr_tabulate
  {m,n:int} (nrow: size_t m, ncol: size_t n): matrixptr (a, m, n)
//
fun{a:vt0p}
matrixptr_tabulate_cloref
  {m,n:int}
(
  nrow: size_t m, ncol: size_t n, f: (sizeLt(m), sizeLt(n)) -<cloref> a
) : matrixptr (a, m, n) // end-of-function
//
(* ****** ****** *)

(*
fun{
a:vt0p}{env:vt0p
} matrix_foreach$fwork (x: &a >> _, env: &(env) >> _): void
*)
//
fun{
a:vt0p
} matrixptr_foreach{m,n:int}
(
  A: !matrixptr(INV(a), m, n) >> _, m: size_t m, n: size_t n
) : void // end of [matrixptr_foreach]
fun{
a:vt0p}{env:vt0p
} matrixptr_foreach_env{m,n:int}
(
  A: !matrixptr(INV(a), m, n) >> _, m: size_t m, n: size_t n, env: &(env) >> _
) : void // end of [matrixptr_foreach_env]

(* ****** ****** *)
//
// overloading for certain symbols
//
(* ****** ****** *)

overload [] with matrixptr_get_at_int
overload [] with matrixptr_get_at_size
overload [] with matrixptr_set_at_int
overload [] with matrixptr_set_at_size

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

overload fprint with fprint_matrixptr
overload fprint with fprint_matrixptr_sep

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

overload ptrcast with matrixptr2ptr
overload ptrcast with matrixptrout2ptr

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

(* end of [matrixptr.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/matrixref.atxt
** Time of generation: Thu Aug 31 20:28:28 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: April, 2013 *)

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

#define NSH (x) x // for commenting: no sharing
#define SHR (x) x // for commenting: it is shared

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

sortdef tk = tkind

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

sortdef t0p = t@ype and vt0p = viewt@ype

(* ****** ****** *)
//
// matrixref:
// reference to a matrix
// with no dimension info attached
//
(* ****** ****** *)
//
abstype
matrixref_vt0ype_int_int_type
  (a:vt@ype(*inv*), nrow: int, ncol:int) = ptr
//
stadef matrixref = matrixref_vt0ype_int_int_type
//
(* ****** ****** *)

praxi
lemma_matrixref_param
  {a:vt0p}{m,n:int}
  (M: matrixref(a, m, n)): [m >= 0; n >= 0] void
// end of [lemma_matrixref_param]

(* ****** ****** *)
//
castfn
matrixref2ptr
  {a:vt0p}{m,n:int}(M: matrixref(INV(a), m, n)):<> Ptr0
//
(* ****** ****** *)
//
castfn
matrixptr_refize
  {a:vt0p}{l:addr}{m,n:int}
  (matrixptr(INV(a), l, m, n)):<!wrt> matrixref(a, m, n)
//
castfn
matrixref_get_viewptr
  {a:vt0p}
  {m,n:int}
(
  M: matrixref(a, m, n)
) :<> [l:addr] (vbox(matrix_v(a, l, m, n)) | ptr l)
//
(* ****** ****** *)

castfn
arrayref2matrixref
  {a:vt0p}{m,n:nat}
  (A: arrayref(a, m*n)):<> matrixref(a, m, n)
// end of [arrayref2matrixref]

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

fun{
a:t0p
} matrixref_make_elt
  {m,n:int}
  (size_t(m), size_t(n), x0: a):<!wrt> matrixref(a, m, n)
// end of [matrixref_make_elt]

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

fun{a:t0p}
matrixref_get_at_int
  {m,n:int}
(
  M: matrixref(a, m, n), i: natLt(m), n: int(n), j: natLt(n)
) :<!ref> (a) // end of [matrixref_get_at_int]

fun{a:t0p}
matrixref_get_at_size
  {m,n:int}
(
  M: matrixref(a, m, n), i: sizeLt(m), n: size_t(n), j: sizeLt(n)
) :<!ref> (a) // end of [matrixref_get_at_size]
//
symintr matrixref_get_at
overload matrixref_get_at with matrixref_get_at_int of 0
overload matrixref_get_at with matrixref_get_at_size of 0
//
(* ****** ****** *)

fun{a:t0p}
matrixref_set_at_int
  {m,n:int}
(
  M: matrixref(a, m, n), i: natLt(m), n: int n, j: natLt(n), x: a
) :<!refwrt> void // end of [matrixref_set_at_int]

fun{a:t0p}
matrixref_set_at_size
  {m,n:int}
(
  M: matrixref(a, m, n), i: sizeLt(m), n: size_t n, j: sizeLt(n), x: a
) :<!refwrt> void // end of [matrixref_set_at_size]

symintr matrixref_set_at
overload matrixref_set_at with matrixref_set_at_int of 0
overload matrixref_set_at with matrixref_set_at_size of 0

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

fun{a:vt0p}
matrixref_exch_at_int
  {m,n:int}
(
  M: matrixref(a, m, n)
, i: natLt(m), n: int n, j: natLt(n), x: &a >> _
) :<!refwrt> void // end of [matrixref_exch_at_int]

fun{a:vt0p}
matrixref_exch_at_size
  {m,n:int}
(
  M: matrixref(a, m, n)
, i: sizeLt(m), n: size_t n, j: sizeLt(n), x: &a >> _
) :<!refwrt> void // end of [matrixref_exch_at_size]

symintr matrixref_exch_at
overload matrixref_exch_at with matrixref_exch_at_int of 0
overload matrixref_exch_at with matrixref_exch_at_size of 0

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

(*
fprint_matrix$sep1 // col separation
fprint_matrix$sep2 // row separation
*)
fun{a:vt0p}
fprint_matrixref{m,n:int}
(
  out: FILEref
, M: matrixref(a, m, n), m: size_t m, n: size_t n
) : void // end of [fprint_matrixref]

fun{a:vt0p}
fprint_matrixref_sep{m,n:int}
(
  out: FILEref
, M: matrixref(a, m, n), m: size_t(m), n: size_t(n)
, sep1: NSH(string), sep2: NSH(string)
) : void // end of [fprint_matrixref_sep]

(* ****** ****** *)
//
fun{a:t0p}
matrixref_copy
  {m,n:int}
(
  M: matrixref(a, m, n), m: size_t(m), n: size_t(n)
) : matrixptr (a, m, n) // end-of-fun
//
(* ****** ****** *)

(*
fun{a:vt0p}
matrix_tabulate$fopr(i: size_t, j: size_t): (a)
*)
fun{a:vt0p}
matrixref_tabulate
  {m,n:int}
  (nrow: size_t m, ncol: size_t n): matrixref(a, m, n)
//
fun{a:vt0p}
matrixref_tabulate_cloref
  {m,n:int}
(
  nrow: size_t m, ncol: size_t n, f: (sizeLt(m), sizeLt(n)) -<cloref> a
) : matrixref(a, m, n) // end-of-fun
//
(* ****** ****** *)

(*
fun{
a:vt0p}{env:vt0p
} matrix_foreach$fwork
  (x: &a >> _, env: &(env) >> _): void
*)
//
fun{
a:vt0p
} matrixref_foreach{m,n:int}
(
  A: matrixref(a, m, n), m: size_t m, n: size_t n
) : void // end of [matrixref_foreach]
//
fun{
a:vt0p}{env:vt0p
} matrixref_foreach_env{m,n:int}
(
  A: matrixref(a, m, n), m: size_t m, n: size_t n, env: &(env) >> _
) : void // end of [matrixref_foreach_env]
//
fun{
a:vt0p
} matrixref_foreach_cloref{m,n:int}
(
  A: matrixref(a, m, n), m: size_t(m), n: size_t(n), fwork: (&(a) >> _) -<cloref1> void 
) : void // end of [mtrxszref_foreach_cloref]
//
(* ****** ****** *)
//
// mtrxszref: a reference to a matrix with size information attached
//
(* ****** ****** *)
//
abstype // in-variant
mtrxszref_vt0ype_type(a:vt@ype) = ptr
//
stadef mtrxszref = mtrxszref_vt0ype_type
//
(* ****** ****** *)

fun{}
mtrxszref_make_matrixref
  {a:vt0p}{m,n:int}
(
  M: matrixref(a, m, n), m: size_t m, n: size_t n
) :<!wrt> mtrxszref(a) // endfun

(* ****** ****** *)
//
fun{}
mtrxszref_get_ref{a:vt0p} (M: mtrxszref(a)):<> Ptr1
//
fun{}
mtrxszref_get_nrow{a:vt0p} (M: mtrxszref(a)):<> size_t
fun{}
mtrxszref_get_ncol{a:vt0p} (M: mtrxszref(a)):<> size_t
//
(* ****** ****** *)

symintr .ref
overload .ref with mtrxszref_get_ref

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

fun{}
mtrxszref_get_refsize{a:vt0p}
(
  M: mtrxszref(a)
, nrol: &size_t? >> size_t m, ncol: &size_t? >> size_t(n)
) :<!wrt> #[m,n:nat] matrixref(a, m, n) // endfun

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

fun{a:t0p}
mtrxszref_make_elt
  (nrow: size_t, ncol: size_t, init: a):<!wrt> mtrxszref(a)
// end of [mtrxszref_make_elt]

(* ****** ****** *)
//
fun{a:t0p}
mtrxszref_get_at_int
  (M: mtrxszref(a), i: int, j: int):<!exnref> (a)
fun{a:t0p}
mtrxszref_get_at_size
  (M: mtrxszref(a), i: size_t, j: size_t):<!exnref> (a)
//
symintr mtrxszref_get_at
overload mtrxszref_get_at with mtrxszref_get_at_int of 0
overload mtrxszref_get_at with mtrxszref_get_at_size of 0
//
(* ****** ****** *)
//
fun{a:t0p}
mtrxszref_set_at_int
  (M: mtrxszref(a), i: int, j: int, x: a):<!exnrefwrt> void
fun{a:t0p}
mtrxszref_set_at_size
  (M: mtrxszref(a), i: size_t, j: size_t, x: a):<!exnrefwrt> void
//
symintr mtrxszref_set_at
overload mtrxszref_set_at with mtrxszref_set_at_int of 0
overload mtrxszref_set_at with mtrxszref_set_at_size of 0
//
(* ****** ****** *)

(*
fprint_matrix$sep1 // col separation
fprint_matrix$sep2 // row separation
*)
fun{a:vt0p}
fprint_mtrxszref
(
  out: FILEref, M: mtrxszref(a)
) : void // end of [fprint_mtrxszref]

fun{a:vt0p}
fprint_mtrxszref_sep
(
  out: FILEref
, M: mtrxszref(a), sep1: NSH(string), sep2: NSH(string)
) : void // end of [fprint_mtrxszref_sep]

(* ****** ****** *)
//
(*
fun{
a:vt0p}{env:vt0p
} matrix_foreach$fwork
  (x: &a >> _, env: &(env) >> _): void
*)
//
fun
{a:vt0p}
mtrxszref_foreach(mtrxszref(a)): void
fun{
a:vt0p}{env:vt0p
} mtrxszref_foreach_env(mtrxszref(a), &(env) >> _) : void
//
fun
{a:vt0p}
mtrxszref_foreach_cloref
  (M: mtrxszref(a), fwork: (&(a) >> _) -<cloref1> void ): void
//
(* ****** ****** *)
//
(*
fun
{a:vt0p}
matrix_tabulate$fopr(i: size_t, j: size_t): (a)
*)
fun
{a:vt0p}
mtrxszref_tabulate
  (nrow: size_t, ncol: size_t): mtrxszref(a)
//
fun
{a:vt0p}
mtrxszref_tabulate_cloref
  {m,n:int}
(
  m: size_t(m), n: size_t(n), f: (sizeLt(m), sizeLt(n)) -<cloref> a
) : mtrxszref(a) // end-of-fun
//
(* ****** ****** *)
//
fun{a:t0p}
streamize_mtrxszref_row_elt
  (MSZ: mtrxszref(a)): stream_vt(a)
fun{a:t0p}
streamize_mtrxszref_col_elt
  (MSZ: mtrxszref(a)): stream_vt(a)
//
fun{a:t0p}
streamize_matrixref_row_elt
  {m,n:int}
  (matrixref(a, m, n), size_t(m), size_t(n)): stream_vt(a)
fun{a:t0p}
streamize_matrixref_col_elt
  {m,n:int}
  (matrixref(a, m, n), size_t(m), size_t(n)): stream_vt(a)
//
(* ****** ****** *)
//
// overloading for certain symbols
//
(* ****** ****** *)

overload [] with matrixref_get_at_int of 0
overload [] with matrixref_get_at_size of 0
overload [] with matrixref_set_at_int of 0
overload [] with matrixref_set_at_size of 0

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

overload [] with mtrxszref_get_at_int of 0
overload [] with mtrxszref_get_at_size of 0
overload [] with mtrxszref_set_at_int of 0
overload [] with mtrxszref_set_at_size of 0

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

overload .nrow with mtrxszref_get_nrow
overload .ncol with mtrxszref_get_ncol

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

overload fprint with fprint_matrixref
overload fprint with fprint_matrixref_sep
overload fprint with fprint_mtrxszref
overload fprint with fprint_mtrxszref_sep

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

overload ptrcast with matrixref2ptr

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

(* end of [matrixref.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/gprint.atxt
** Time of generation: Fri Aug 18 03:29:55 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: August, 2012 *)

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

#define NSH (x) x // for commenting: no sharing
#define SHR (x) x // for commenting: it is shared

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

sortdef t0p = t@ype

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

fun{}
gprint$out(): FILEref

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

fun{}
gprint_flush(): void

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

fun{}
gprint_newline(): void

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

fun{a:t0p}
gprint_val (x: a): void
fun{a:vt0p}
gprint_ref (x: &INV(a)): void

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

fun{}
gprint_int (x: int): void
fun{}
gprint_bool (x: bool): void
fun{}
gprint_char (x: char): void
fun{}
gprint_float (x: float): void
fun{}
gprint_double (x: double): void
fun{}
gprint_string (x: string): void

(* ****** ****** *)
//
overload gprint with gprint_int
overload gprint with gprint_bool
overload gprint with gprint_char
overload gprint with gprint_float
overload gprint with gprint_double
overload gprint with gprint_string
//
(* ****** ****** *)

fun{} gprint_list$beg(): void
fun{} gprint_list$end(): void
fun{} gprint_list$sep(): void
//
fun{a:t0p}
gprint_list (xs: List(a)): void
//
overload gprint with gprint_list
//
(* ****** ****** *)

fun{} gprint_listlist$beg1(): void
fun{} gprint_listlist$end1(): void
fun{} gprint_listlist$sep1(): void
//
fun{} gprint_listlist$beg2(): void
fun{} gprint_listlist$end2(): void
fun{} gprint_listlist$sep2(): void
//
fun{a:t0p}
gprint_listlist (xss: List(List(a))): void

(* ****** ****** *)
//
fun{} gprint_array$beg(): void
fun{} gprint_array$end(): void
fun{} gprint_array$sep(): void
//
fun{a:t0p}
gprint_array
  {n:int}
(
  &(@[INV(a)][n]), size_t(n)
) : void // end-of-function
//
fun{a:t0p}
gprint_arrayptr
  {n:int}
(
  !arrayptr(INV(a), n), size_t(n)
) : void // end-of-function
//
fun{a:t0p}
gprint_arrayref
  {n:int}
  (arrayref(a, n), size_t(n)): void
// end of [gprint_arrayref]
//
(* ****** ****** *)
//
fun{a:t0p}
gprint_arrszref(ASZ: arrszref(a)): void
//
overload gprint with gprint_arrayref
//
(* ****** ****** *)

(* end of [gprint.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/SATS/CODEGEN/tostring.atxt
** Time of generation: Fri Aug 18 03:29:56 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: August, 2012 *)

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

vtypedef
RD(a:vt0p) = a // for commenting: read-only
#define NSH (x) x // for commenting: no sharing
#define SHR (x) x // for commenting: it is shared

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

sortdef t0p = t@ype
sortdef vt0p = vt@ype

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

fun{}
tostring_int(int):<> string
fun{}
tostrptr_int(int):<!wrt> Strptr1

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

fun{}
tostring_uint(uint):<> string
fun{}
tostrptr_uint(uint):<!wrt> Strptr1

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

fun{}
tostring_bool(bool):<> string
fun{}
tostrptr_bool(bool):<!wrt> Strptr1

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

fun{}
tostring_char(char):<> string
fun{}
tostrptr_char(char):<!wrt> Strptr1

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

fun{}
tostring_double(double):<> string
fun{}
tostrptr_double(double):<!wrt> Strptr1

(* ****** ****** *)
//
fun
{a:t0p}
tostrptr_list
  (xs0: List(INV(a))): Strptr1
//
fun{}
tostrptr_list$beg((*void*)): String
fun{}
tostrptr_list$end((*void*)): String
fun{}
tostrptr_list$sep((*void*)): String
//
(* ****** ****** *)
//
fun
{a:vt0p}
tostrptr_array
  {n:int}
(
  &array(INV(a), n), size_t(n)
) : Strptr1 // end-of-function
//
fun{}
tostrptr_array$beg((*void*)): String
fun{}
tostrptr_array$end((*void*)): String
fun{}
tostrptr_array$sep((*void*)): String
//
(* ****** ****** *)
//
fun
{a:vt0p}
tostrptr_arrayref
  {n:int}
  (arrayref(a,n), size_t(n)): Strptr1
//
fun
{a:vt0p}
tostrptr_arrszref(arrszref(a)): Strptr1
//
(* ****** ****** *)

(* end of [tostring.sats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/basics.atxt
** Time of generation: Fri Aug 18 03:30:01 2017
*)

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

(* Author: Hongwei Xi *)
(* Start time: March, 2012 *)
(* Authoremail: hwxiATcsDOTbuDOTedu *)

(* ****** ****** *)
//
// HX-2017-03-08:
#define // there is no need
ATS_DYNLOADFLAG 0 // for dynloading
//
(* ****** ****** *)
//
staload UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
implement
patsopt_version((*void*)) = "0.3.4"
//
(* ****** ****** *)
//
primplmnt
false_elim() = case+ 0 of _ =/=> ()
//
(* ****** ****** *)

primplmnt prop_verify () = ()
primplmnt prop_verify_and_add () = ()

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

primplmnt pridentity_v (x) = ()
primplmnt pridentity_vt (x) = ()

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

primplmnt eqint_make () = EQINT ()
primplmnt eqint_make_gint (x) = EQINT ()
primplmnt eqint_make_guint (x) = EQINT ()

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

primplmnt eqaddr_make () = EQADDR ()
primplmnt eqaddr_make_ptr (x) = EQADDR ()

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

primplmnt eqbool_make () = EQBOOL ()
primplmnt eqbool_make_bool (x) = EQBOOL ()

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

implement
{a}(*tmp*)
lazy_force (lazyval) = !lazyval
implement
{a}(*tmp*)
lazy_vt_force (lazyval) = !lazyval

(* ****** ****** *)
//
implement
{a}(*tmp*)
stamped_vt2t_ref{x}(x) =
  $UN.ptr0_get<stamped_t(a,x)>(addr@x)
//
(* ****** ****** *)

primplmnt
unit_v_elim (pf) = let
  prval unit_v () = pf in (*nothing*)
end // end of [unit_v_elim]

(* ****** ****** *)
//
implement{a} box(x) = $UN.cast(x)
implement{a} unbox(x) = $UN.cast(x)
//
implement{a} box_vt(x) = $UN.castvwtp0(x)
implement{a} unbox_vt(x) = $UN.castvwtp0(x)
//
(* ****** ****** *)
//
// HX:
// See prelude/basics_dyn.sats
//
implement
{a}(*tmp*)
opt_unsome_get (x) =
  let prval () = opt_unsome (x) in x end
//
(* ****** ****** *)

(*
//
// HX: [atspre_argv_at_at] in basics.cats
//
implement
argv_get_at
  (argv, i) = x where {
  val (pf, fpf | p) =
    argv_takeout_strarr (argv)
  val x = !p.[i]
  prval () = minus_addback (fpf, pf | argv)
} // end of [argv_get_at]
*)
(* ****** ****** *)

implement
{}(*tmp*)
listize_argc_argv
  {n}(argc, argv) = let
//
prval () =
  lemma_argv_param(argv)
//
fun
loop
{i:nat | i <= n} .<n-i>.
(
argv: !argv(n), i0: int(i),
res0: &ptr? >> list_vt(string, n-i)
) : void =
(
if
(i0 < argc)
then let
  val x0 = argv[i0]
  val () =
    res0 :=
    list_vt_cons{string}{0}(x0, _)
  // end of [val]
  val+list_vt_cons(_, res1) = res0
  val () = loop(argv, i0+1, res1)
  prval ((*folded*)) = fold@(res0)
in
  // nothing
end // end of [then]
else () where
{
  val () = res0 := list_vt_nil()
}
) (* end of [loop] *)
//
in
  let var res0: ptr in loop(argv, 0, res0); res0 end
end // end of [listize_argc_argv]

(* ****** ****** *)
//
implement{}
assertexn_bool0 (b) =
  if not(b) then $raise AssertExn()
//
implement{}
assertexn_bool1 (b) =
  if not(b) then $raise AssertExn()
//
(* ****** ****** *)

implement
{a}(*tmp*)
gidentity (x) = (x)
implement
{a}(*tmp*)
gidentity_vt (x) = (x)

(* ****** ****** *)
//
implement
(a:t@ype)
gcopy_val<a> (x) = (x)
//
implement
(a:t@ype)
gcopy_ref<a> (x) = (x)
//
(* ****** ****** *)
//
implement
(a:t@ype)
gfree_val<a> (x) = ((*void*))
//
(*
implement
(a:t@ype)
gfree_ref<a> (x) = ((*void*))
*)
//
(* ****** ****** *)
//
implement
(a:t@ype)
gclear_ref<a> (x) = ((*void*))
//
(* ****** ****** *)
//
implement
gequal_val_val<int> (x, y) = (x = y)
implement
gequal_val_val<bool> (x, y) = (x = y)
implement
gequal_val_val<char> (x, y) = (x = y)
implement
gequal_val_val<double> (x, y) = (x = y)
implement
gequal_val_val<string> (x, y) = (x = y)
//
(* ****** ****** *)
//
implement
(a:t@ype)
gequal_ref_ref<a>
  (x, y) = gequal_val_val<a> (x, y)
//
(* ****** ****** *)
//
implement
{a}(*tmp*)
tostring_val(x) = let
//
val str =
  $effmask_wrt(tostrptr_val<a>(x))
in
  strptr2string(str)
end // end of [tostring_val]
//
implement
{a}(*tmp*)
tostring_ref(x) = let
//
val str =
  $effmask_wrt(tostrptr_ref<a>(x))
in
  strptr2string(str)
end // end of [tostring_ref]
//
(* ****** ****** *)

implement
(a:t@ype)
tostrptr_ref<a> (x) = tostrptr_val<a> (x)

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

implement
{a}(*tmp*)
fprint_val (out, x) = let
  val str = tostrptr_val<a> (x)
  val ((*void*)) = fprint_strptr (out, str)
  val ((*void*)) = strptr_free (str)
in
  // nothing
end // end of [fprint_val]

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

implement
(a:t@ype)
fprint_ref<a> (out, x) = fprint_val<a> (out, x)

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

(*
//
// HX-2014-02-25: commented out
//
implement{a}
print_val (x) = fprint_val<a> (stdout_ref, x)
implement{a}
prerr_val (x) = fprint_val<a> (stderr_ref, x)
implement{a}
print_ref (x) = fprint_ref<a> (stdout_ref, x)
implement{a}
prerr_ref (x) = fprint_ref<a> (stderr_ref, x)
*)

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

(* end of [basics.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(* Author: Hongwei Xi *)
(* Start time: May, 2012 *)
(* Authoremail: gmhwxiATgmailDOTcom *)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/integer.atxt
** Time of generation: Fri Aug 18 03:29:57 2017
*)

(* ****** ****** *)
//
#define
ATS_DYNLOADFLAG 0 // no dynloading
//
(* ****** ****** *)
//
staload UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
implement
g0int2int<intknd,intknd> =
  g0int2int_int_int(*unary*)
//
(* ****** ****** *)
//
implement
g0int_neg<intknd> = g0int_neg_int
implement
g0int_abs<intknd> = g0int_abs_int
implement
g0int_succ<intknd> = g0int_succ_int
implement
g0int_pred<intknd> = g0int_pred_int
implement
g0int_half<intknd> = g0int_half_int
implement
g0int_add<intknd> = g0int_add_int
implement
g0int_sub<intknd> = g0int_sub_int
implement
g0int_mul<intknd> = g0int_mul_int
implement
g0int_div<intknd> = g0int_div_int
implement
g0int_mod<intknd> = g0int_mod_int
implement
g0int_asl<intknd> = g0int_asl_int
implement
g0int_asr<intknd> = g0int_asr_int
implement
g0int_isltz<intknd> = g0int_isltz_int
implement
g0int_isltez<intknd> = g0int_isltez_int
implement
g0int_isgtz<intknd> = g0int_isgtz_int
implement
g0int_isgtez<intknd> = g0int_isgtez_int
implement
g0int_iseqz<intknd> = g0int_iseqz_int
implement
g0int_isneqz<intknd> = g0int_isneqz_int
implement
g0int_lt<intknd> = g0int_lt_int
implement
g0int_lte<intknd> = g0int_lte_int
implement
g0int_gt<intknd> = g0int_gt_int
implement
g0int_gte<intknd> = g0int_gte_int
implement
g0int_eq<intknd> = g0int_eq_int
implement
g0int_neq<intknd> = g0int_neq_int
implement
g0int_compare<intknd> = g0int_compare_int
implement
g0int_max<intknd> = g0int_max_int
implement
g0int_min<intknd> = g0int_min_int
//
implement
fprint_val<int> (out, x) = fprint_int (out, x)
//
(* ****** ****** *)
//
implement
{}(*tmp*)
add_int1_size0(i, j) =
let val i =
  g1int2uint_int_size(i) in i + j
end // end of [add_int1_size0]
implement
{}(*tmp*)
add_size0_int1(i, j) =
let val j =
  g1int2uint_int_size(j) in i + j
end // end of [add_size0_int1]
//
(* ****** ****** *)
//
implement
{}(*tmp*)
mul_int1_size0(i, j) =
let val i =
  g1int2uint_int_size(i) in i * j
end // end of [mul_int1_size0]
implement
{}(*tmp*)
mul_size0_int1(i, j) =
let val j =
  g1int2uint_int_size(j) in i * j
end // end of [mul_size0_int1]
//
(* ****** ****** *)

implement
{tk}(*tk*)
g0int_npow
  (x, n) = let
//
typedef gint = g0int(tk)
//
fun
loop
(
  x: gint, res: gint, n: int
) : gint = (
//
if
(n > 1)
then let
  val n2 = n >> 1
  val b0 = n - (n2 << 1)
  val xx = x * x
in
  if b0 = 0
    then loop(xx, res, n2) else loop(xx, x * res, n2)
  // end of [if]
end // end of [then]
else (
  if n > 0 then x * res else res
) (* end of [else] *)
//
) (* end of [loop] *)
//
val res = $UN.cast{gint}(1)
//
in
  $effmask_all(loop(x, res, n))
end // end of [g0int_npow]

(* ****** ****** *)
//
implement
g1int2int<intknd,intknd> =
  g1int2int_int_int(*unary*)
//
(* ****** ****** *)
//
implement
g1int_neg<intknd> = g1int_neg_int
implement
g1int_abs<intknd> = g1int_abs_int
implement
g1int_succ<intknd> = g1int_succ_int
implement
g1int_pred<intknd> = g1int_pred_int
implement
g1int_half<intknd> = g1int_half_int
implement
g1int_add<intknd> = g1int_add_int
implement
g1int_sub<intknd> = g1int_sub_int
implement
g1int_mul<intknd> = g1int_mul_int
implement
g1int_div<intknd> = g1int_div_int
implement
g1int_nmod<intknd> = g1int_nmod_int
implement
g1int_isltz<intknd> = g1int_isltz_int
implement
g1int_isltez<intknd> = g1int_isltez_int
implement
g1int_isgtz<intknd> = g1int_isgtz_int
implement
g1int_isgtez<intknd> = g1int_isgtez_int
implement
g1int_iseqz<intknd> = g1int_iseqz_int
implement
g1int_isneqz<intknd> = g1int_isneqz_int
implement
g1int_lt<intknd> = g1int_lt_int
implement
g1int_lte<intknd> = g1int_lte_int
implement
g1int_gt<intknd> = g1int_gt_int
implement
g1int_gte<intknd> = g1int_gte_int
implement
g1int_eq<intknd> = g1int_eq_int
implement
g1int_neq<intknd> = g1int_neq_int
implement
g1int_compare<intknd> = g1int_compare_int
implement
g1int_max<intknd> = g1int_max_int
implement
g1int_min<intknd> = g1int_min_int
//
(* ****** ****** *)
//
implement
{tk}(*tmp*)
g0int_sgn(x) =
g1int_sgn<tk>(g1ofg0_int{tk}(x))
implement
{tk}(*tmp*)
g1int_sgn(x) =
compare_g1int_int<tk>(x, 0(*int*))
//
(* ****** ****** *)
//
implement{}
add_size1_int1
  {i,j}(i, j) =
  $UN.cast{size_t(i+j)}(i+g0i2u(j))
implement{}
add_int1_size1
  {i,j}(i, j) =
  $UN.cast{size_t(i+j)}(g0i2u(i)+j)
//
implement{}
sub_size1_int1
  {i,j}(i, j) =
  $UN.cast{size_t(i-j)}(i-g0i2u(j))
//
(* ****** ****** *)

implement
{tk}(*tmp*)
g1int_mul2
{i,j}(x, y) = let
//
prval
pfmul =
mul_make{i,j}() in
  (pfmul | g1int_mul<tk>(x, y))
//
end // end of [g1int_mul2]

(* ****** ****** *)
//
implement
{}(*tmp*)
mul_int1_size1
  {i,j}(i, j) =
  $UN.cast{size_t(i*j)}(g0i2u(i)*j)
implement
{}(*tmp*)
mul_size1_int1
  {i,j}(i, j) =
  $UN.cast{size_t(i*j)}(i*g0i2u(j))
//
(* ****** ****** *)

implement
{tk}(*tmp*)
g1int_ndiv
  {i,j}(x, y) = let
//
val quot =
g1int_div<tk>(x, y) in
  $UN.cast{g1int(tk,ndiv(i,j))}(quot)
//
end // end of [let] // end of [g1int_ndiv]

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

implement
{tk}(*tmp*)
g1int_ndiv2
  {i,j}(x, y) = let
//
val
[q:int] q = g1int_div(x, y)
//
prval
[q2:int,r:int]
pf_istot = divmod_istot{i,j}()
//
prval
EQINT((*void*)) =
  $UN.castview0{EQINT(q,q2)}(0)
//
in
  (pf_istot | q(*quotient*))
end // end of [let] // end of [g1int_ndiv2]

(* ****** ****** *)
//
implement
{tk}(*tmp*)
ndiv_g1int_int1
  (x, y) = g1i2i(g1int_ndiv(x, g1i2i(y)))
//
(* ****** ****** *)

implement
{tk}(*tmp*)
g1int_nmod2
  {i,j}(x, y) = let
//
val r = g1int_nmod(x, y)
//
prval
[q:int,r2:int]
pf_istot = divmod_istot{i,j}()
//
prval
EQINT((*void*)) =
  $UN.castview0{EQINT(i%j,r2)}(0)
//
in
  (pf_istot | r(*remainder*))
end // end of [let] // end of [g1int_nmod2]

(* ****** ****** *)
//
implement
{tk}(*tmp*)
nmod_g1int_int1
  (x, y) = g1i2i(g1int_nmod(x, g1i2i(y)))
//
(* ****** ****** *)

implement
{tk}(*tmp*)
nmod2_g1int_int1
  {i,j}(x, y) = let
//
val r = nmod_g1int_int1(x, y)
//
prval
[q:int,r2:int]
pf_istot = divmod_istot{i,j}()
//
prval
EQINT((*void*)) = $UN.castview0{EQINT(i%j,r2)}(0)
//
in
  (pf_istot | r(*remainder*))
end // end of [let] // end of [nmod2_g1int_int1]

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

(*
//
// HX-2016-12:
// [ngcd] is no longer pre-declared
//
implement
{tk}(*tmp*)
g1int_ngcd
  (x, y) = let
//
fun
loop{i,j:nat} .<j>.
(
  x: g1int(tk, i)
, y: g1int(tk, j)
) :<> [r:nat] g1int(tk, r) = let
in
//
if y > 0 then loop (y, g1int_nmod(x, y)) else x
//
end // end of [loop]
//
in
  loop (x, y)
end // end of [g1int_ngcd]
*)

(* ****** ****** *)
//
// HX: int -> uint
//
implement
g0int2uint<intknd,uintknd> = g0int2uint_int_uint
//
(* ****** ****** *)
//
// HX: uint -> int
//
implement
g0uint2int<uintknd,intknd> = g0uint2int_uint_int
//
(* ****** ****** *)
//
// HX: uint -> uint
//
implement
g0uint2uint<uintknd,uintknd> = g0uint2uint_uint_uint
//
(* ****** ****** *)
//
implement
g0uint_succ<uintknd> = g0uint_succ_uint
implement
g0uint_pred<uintknd> = g0uint_pred_uint
implement
g0uint_half<uintknd> = g0uint_half_uint
implement
g0uint_add<uintknd> = g0uint_add_uint
implement
g0uint_sub<uintknd> = g0uint_sub_uint
implement
g0uint_mul<uintknd> = g0uint_mul_uint
implement
g0uint_div<uintknd> = g0uint_div_uint
implement
g0uint_mod<uintknd> = g0uint_mod_uint
implement
g0uint_lsl<uintknd> = g0uint_lsl_uint
implement
g0uint_lsr<uintknd> = g0uint_lsr_uint
implement
g0uint_lnot<uintknd> = g0uint_lnot_uint
implement
g0uint_lor<uintknd> = g0uint_lor_uint
implement
g0uint_lxor<uintknd> = g0uint_lxor_uint
implement
g0uint_land<uintknd> = g0uint_land_uint
implement
g0uint_isgtz<uintknd> = g0uint_isgtz_uint
implement
g0uint_iseqz<uintknd> = g0uint_iseqz_uint
implement
g0uint_isneqz<uintknd> = g0uint_isneqz_uint
implement
g0uint_lt<uintknd> = g0uint_lt_uint
implement
g0uint_lte<uintknd> = g0uint_lte_uint
implement
g0uint_gt<uintknd> = g0uint_gt_uint
implement
g0uint_gte<uintknd> = g0uint_gte_uint
implement
g0uint_eq<uintknd> = g0uint_eq_uint
implement
g0uint_neq<uintknd> = g0uint_neq_uint
implement
g0uint_compare<uintknd> = g0uint_compare_uint
implement
g0uint_max<uintknd> = g0uint_max_uint
implement
g0uint_min<uintknd> = g0uint_min_uint
//
implement
fprint_val<uint> (out, x) = fprint_uint (out, x)//
(* ****** ****** *)
//
// HX: int -> uint
//
implement
g1int2uint<intknd,uintknd> = g1int2uint_int_uint
//
(* ****** ****** *)
//
// HX: uint -> int
//
implement
g1uint2int<uintknd,intknd> = g1uint2int_uint_int
//
(* ****** ****** *)
//
// HX: uint -> uint
//
implement
g1uint2uint<uintknd,uintknd> = g1uint2uint_uint_uint
//
(* ****** ****** *)
//
implement
g1uint_succ<uintknd> = g1uint_succ_uint
implement
g1uint_pred<uintknd> = g1uint_pred_uint
implement
g1uint_half<uintknd> = g1uint_half_uint
implement
g1uint_add<uintknd> = g1uint_add_uint
implement
g1uint_sub<uintknd> = g1uint_sub_uint
implement
g1uint_mul<uintknd> = g1uint_mul_uint
implement
g1uint_div<uintknd> = g1uint_div_uint
implement
g1uint_mod<uintknd> = g1uint_mod_uint
implement
g1uint_isgtz<uintknd> = g1uint_isgtz_uint
implement
g1uint_iseqz<uintknd> = g1uint_iseqz_uint
implement
g1uint_isneqz<uintknd> = g1uint_isneqz_uint
implement
g1uint_lt<uintknd> = g1uint_lt_uint
implement
g1uint_lte<uintknd> = g1uint_lte_uint
implement
g1uint_gt<uintknd> = g1uint_gt_uint
implement
g1uint_gte<uintknd> = g1uint_gte_uint
implement
g1uint_eq<uintknd> = g1uint_eq_uint
implement
g1uint_neq<uintknd> = g1uint_neq_uint
implement
g1uint_compare<uintknd> = g1uint_compare_uint
implement
g1uint_max<uintknd> = g1uint_max_uint
implement
g1uint_min<uintknd> = g1uint_min_uint
//
(* ****** ****** *)

implement
{tk}(*tmp*)
g1uint_div2
  {i,j}(x, y) = let
//
prval () = lemma_g1uint_param (x)
//
val [q:int] q = g1uint_div (x, y)
//
prval
[q2:int,r:int] pf = divmod_istot{i,j}((*void*))
//
prval EQINT((*void*)) = $UN.castview0{EQINT(q,q2)}(0)
//
in
  (pf | q)
end // end of [let] // end of [g1uint_div2]

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

implement
{tk}(*tmp*)
g1uint_mod2 {i,j} (x, y) = let
//
  prval () = lemma_g1uint_param (x)
//
  val [r:int] r = g1uint_mod (x, y)
  prval [q:int,r2:int] pf = divmod_istot{i,j}()
  prval EQINT() = $UN.castview0{EQINT(r,r2)}(0)
in
  (pf | r)
end // end of [let] // end of [g1uint_mod2]

(* ****** ****** *)
//
implement g0int2string<intknd> = g0int2string_int
//
(* ****** ****** *)
//
implement g0string2int<intknd> = g0string2int_int
implement g0string2uint<uintknd> = g0string2uint_uint
//
(* ****** ****** *)

implement
{tk}(*tmp*)
g1string2int(rep) = g1ofg0_int(g0string2int<tk>(rep))
implement
{tk}(*tmp*)
g1string2uint(rep) = g1ofg0_uint(g0string2uint<tk>(rep))

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

implement
{tk}(*tmp*)
lt_g0int_int
  (x, y) = g0int_lt<tk> (x, g0int2int(y))
implement
{tk}(*tmp*)
lte_g0int_int
  (x, y) = g0int_lte<tk> (x, g0int2int(y))
//
implement
{tk}(*tmp*)
gt_g0int_int
  (x, y) = g0int_gt<tk> (x, g0int2int(y))
implement
{tk}(*tmp*)
gte_g0int_int
  (x, y) = g0int_gte<tk> (x, g0int2int(y))
//
implement
{tk}(*tmp*)
eq_g0int_int
  (x, y) = g0int_eq<tk> (x, g0int2int(y))
implement
{tk}(*tmp*)
neq_g0int_int
  (x, y) = g0int_neq<tk> (x, g0int2int(y))
//
implement{tk}
compare_g0int_int
  (x, y) = g0int_compare<tk>(x, g0int2int(y))
//
(* ****** ****** *)

implement
{tk}(*tmp*)
lt_g1int_int
  (x, y) = g1int_lt<tk> (x, g1int2int(y))
implement
{tk}(*tmp*)
lte_g1int_int
  (x, y) = g1int_lte<tk> (x, g1int2int(y))
//
implement
{tk}(*tmp*)
gt_g1int_int
  (x, y) = g1int_gt<tk> (x, g1int2int(y))
implement
{tk}(*tmp*)
gte_g1int_int
  (x, y) = g1int_gte<tk> (x, g1int2int(y))
//
implement
{tk}(*tmp*)
eq_g1int_int
  (x, y) = g1int_eq<tk> (x, g1int2int(y))
implement
{tk}(*tmp*)
neq_g1int_int
  (x, y) = g1int_neq<tk> (x, g1int2int(y))
//
implement
{tk}(*tmp*)
compare_g1int_int
  (x, y) = g1int_compare<tk> (x, g1int2int(y))
//
(* ****** ****** *)

implement
{tk}(*tmp*)
lt_g0uint_int
  (x, y) = g0uint_lt<tk> (x, g0int2uint(y))
implement
{tk}(*tmp*)
lte_g0uint_int
  (x, y) = g0uint_lte<tk> (x, g0int2uint(y))
//
implement
{tk}(*tmp*)
gt_g0uint_int
  (x, y) = g0uint_gt<tk> (x, g0int2uint(y))
implement
{tk}(*tmp*)
gte_g0uint_int
  (x, y) = g0uint_gte<tk> (x, g0int2uint(y))
//
implement
{tk}(*tmp*)
eq_g0uint_int
  (x, y) = g0uint_eq<tk> (x, g0int2uint(y))
implement
{tk}(*tmp*)
neq_g0uint_int
  (x, y) = g0uint_neq<tk> (x, g0int2uint(y))
//
(* ****** ****** *)

implement
{tk}(*tmp*)
lt_g1uint_int
  (x, y) = g1uint_lt<tk> (x, g1int2uint(y))
implement
{tk}(*tmp*)
lte_g1uint_int
  (x, y) = g1uint_lte<tk> (x, g1int2uint(y))
//
implement
{tk}(*tmp*)
gt_g1uint_int
  (x, y) = g1uint_gt<tk> (x, g1int2uint(y))
implement
{tk}(*tmp*)
gte_g1uint_int
  (x, y) = g1uint_gte<tk> (x, g1int2uint(y))
//
implement
{tk}(*tmp*)
eq_g1uint_int
  (x, y) = g1uint_eq<tk> (x, g1int2uint(y))
implement
{tk}(*tmp*)
neq_g1uint_int
  (x, y) = g1uint_neq<tk> (x, g1int2uint(y))
//
(* ****** ****** *)

(* end of [integer.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/pointer.atxt
** Time of generation: Fri Aug 18 03:29:57 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: March, 2012 *)

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

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

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

primplmnt
lemma_ptr_param
  {l} (p) = lemma_addr_param {l} ()
// end of [lemma_ptr_param]

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

primplmnt
ptr_get_index{l}(p) = eqaddr_make{l, l}()

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

implement
{a}(*tmp*)
ptr0_succ(p) = add_ptr_bsz(p, sizeof<a>)
implement
{a}(*tmp*)
ptr0_pred(p) = sub_ptr_bsz(p, sizeof<a>)

(* ****** ****** *)
//
implement
{a}(*tmp*)
ptr0_diff(p1, p2) =
(
  sub_ptr0_ptr0(p1, p2) / g0u2i(sizeof<a>)
) (* end of [ptr0_diff] *)
//
(* ****** ****** *)
//
implement
{a}{tk}
ptr0_add_gint(p, i) =
  add_ptr_bsz(p, g0int2uint(i) * sizeof<a>)
implement
{a}{tk}
ptr0_sub_gint(p, i) =
  sub_ptr_bsz(p, g0int2uint(i) * sizeof<a>)
//
implement
{a}{tk}
ptr0_add_guint(p, i) =
  add_ptr_bsz(p, g0uint2uint(i) * sizeof<a>)
implement
{a}{tk}
ptr0_sub_guint(p, i) =
  sub_ptr_bsz(p, g0uint2uint(i) * sizeof<a>)
//
(* ****** ****** *)
//
implement
{a}(*tmp*)
ptr1_succ{l}(p) =
$UN.cast
{ptr(l+sizeof(a))}(add_ptr_bsz(p, sizeof<a>))
implement
{a}(*tmp*)
ptr1_pred{l}(p) =
$UN.cast
{ptr(l-sizeof(a))}(sub_ptr_bsz(p, sizeof<a>))
//
(* ****** ****** *)
//
implement
{a}{tk}
ptr1_add_gint{l}{i}(p, i) =
(
$UN.cast
{ptr(l+i*sizeof(a))}(ptr0_add_gint<a><tk>(p, i))
)
implement
{a}{tk}
ptr1_sub_gint{l}{i}(p, i) =
(
$UN.cast
{ptr(l-i*sizeof(a))}(ptr0_sub_gint<a><tk>(p, i))
)
//
implement
{a}{tk}
ptr1_add_guint{l}{i}(p, i) =
(
$UN.cast
{ptr(l+i*sizeof(a))}(ptr0_add_guint<a><tk>(p, i))
)
implement
{a}{tk}
ptr1_sub_guint{l}{i}(p, i) =
(
$UN.cast
{ptr(l-i*sizeof(a))}(ptr0_sub_guint<a><tk>(p, i))
)
//
(* ****** ****** *)

implement
{a}(*tmp*)
ptr_get(pf | p) = !p

implement
{a}(*tmp*)
ptr_set(pf | p, x) = (!p := x)

implement
{a}(*tmp*)
ptr_exch(pf | p, xr) =
{
  val x0 = xr
  val () = xr := !p; val () = !p := x0
} (* end of [ptr_exch] *)

(* ****** ****** *)
//
implement
{a}(*tmp*)
cptr_succ{l}(cp) =
$UN.cast(add_ptr_bsz(cptr2ptr(cp), sizeof<a>))
implement
{a}(*tmp*)
cptr_pred{l}(cp) =
$UN.cast(sub_ptr_bsz(cptr2ptr(cp), sizeof<a>))
//
(* ****** ****** *)

implement
{a}(*tmp*)
ptr_nullize
  (pf | x) =
(
  ptr_nullize_tsz{a}(pf | x, sizeof<a>)
) (* ptr_nullize *)

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

implement
{a}(*tmp*)
ptr_alloc() = ptr_alloc_tsz{a}(sizeof<a>)

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

implement
{a}(*tmp*)
aptr_make_elt(x) = let
//
val (pf, fpf | p) = ptr_alloc()
//
in
  !p := x;
  $UN.castvwtp0{aPtr1(a)}((pf, fpf, p))
end // end of [aptr_make_elt]

(* ****** ****** *)
//
implement
{a}(*tmp*)
aptr_getfree_elt
  {l}(ap) = x0 where
{
//
val p0 = aptr2ptr(ap)
val x0 = $UN.ptr1_get<a>(p0)
//
prval
pfat_ = $UN.castview0{(a?)@l}(0)
prval
pfgc_ = $UN.castview0{mfree_gc_v(l)}(0)
//
val () = ptr_free{a?}{l}(pfgc_, pfat_ | p0)
//
prval () = $UN.cast2void(ap)
//
} (* end of [aptr_getfree_elt] *)
//
(* ****** ****** *)
//
implement
{a}(*tmp*)
aptr_get_elt
  (ap) = x0 where
{
val x0 =
$UN.ptr1_get<a>(aptr2ptr(ap))
//
prval ((*void*)) = $UN.castvwtp2void(ap)
//
} (* end of [aptr_get_elt] *)
implement
{a}(*tmp*)
aptr_set_elt
  (ap, x0) = () where
{
val () =
$UN.ptr1_set<a>(aptr2ptr(ap), x0)
//
  prval ((*void*)) = $UN.castvwtp2void(ap)
//
} (* end of [aptr_set_elt] *)
//
implement
{a}(*tmp*)
aptr_exch_elt
  (ap, x0) =
  $UN.ptr1_exch<a>(aptr2ptr(ap), x0)
//
(* ****** ****** *)
//
//
implement
{a}(*tmp*)
aptr_vtget0_elt
  {l}(ap) = x0 where
{
//
val x0 =
  $UN.ptr1_get<a>(aptr2ptr(ap))
//
prval () = $UN.castvwtp2void(ap)
//
} (* end of [aptr_vtget0_elt] *)
//
implement
{a}(*tmp*)
aptr_vtget1_elt
  {l}(ap) =
  $UN.castvwtp0{res}(x0) where
{
//
val x0 = $UN.ptr1_get<a>(aptr2ptr(ap))
vtypedef res = (minus_v(aptr(a,l), a) | a)
//
} (* end of [aptr_vtget1_elt] *)
//
(* ****** ****** *)

implement
fprint_val<ptr>(out, p) = fprint_ptr(out, p)

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

(* end of [pointer.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/memory.atxt
** Time of generation: Fri Aug 18 03:30:00 2017
*)

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

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

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

implement
{}(*tmp*)
memory$free{l}
  (pfat, pfmf | p) = let
//
prval pfgc = $UN.castview0{mfree_gc_v(l)}(pfmf)
//
in
  mfree_gc (pfat, pfgc | p)
end // end of [memory$free]

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

implement
{}(*tmp*)
memory$alloc
  {n} (bsz) = let
//
val [l:addr]
  (pfat, pfgc | p) = malloc_gc (bsz)
prval pfmf = $UN.castview0{memory$free_v(l)}(pfgc)
//
in
  (pfat, pfmf | p)
end // end of [memory$alloc]

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

(* end of [memory.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/bool.atxt
** Time of generation: Fri Aug 18 03:29:58 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: Feburary, 2012 *)

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

#define ATS_DYNLOADFLAG 0 // no dynloading at run-time

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

(*
//
// HX: see CATS/bool.cats
//
implement
bool2string
  (b) = if b then "true" else "false"
// end of [bool2string]
*)

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

(*
//
// HX: see CATS/bool.cats
//
implement
fprint_bool (out, x) =
  fprint_string (out, bool2string (x))
// end of [fprint_bool]
*)

implement fprint_val<bool> = fprint_bool

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

(* end of [bool.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/char.atxt
** Time of generation: Fri Aug 18 03:29:58 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: Feburary, 2012 *)

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

#define ATS_DYNLOADFLAG 0 // no dynloading at run-time

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

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

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

implement{tk}
g0int_of_char
  (c) = __cast (c) where {
  extern castfn __cast (c: char):<> g0int (tk)
} // end of [g0int_of_char]
implement{tk}
g0int_of_schar
  (c) = __cast (c) where {
  extern castfn __cast (c: schar):<> g0int (tk)
} // end of [g0int_of_schar]
implement{tk}
g0int_of_uchar
  (c) = __cast (c) where {
  extern castfn __cast (c: uchar):<> g0int (tk)
} // end of [g0int_of_uchar]

implement{tk}
g0uint_of_uchar
  (c) = __cast (c) where {
  extern castfn __cast (c: uchar):<> g0uint (tk)
} // end of [g0uint_of_uchar]

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

implement{tk}
g1int_of_char1
  {c} (c) = __cast (c) where {
  extern castfn __cast (c: char c):<> g1int (tk, c)
} // end of [g1int_of_char1]
implement{tk}
g1int_of_schar1
  {c} (c) = __cast (c) where {
  extern castfn __cast (c: schar c):<> g1int (tk, c)
} // end of [g1int_of_schar1]
implement{tk}
g1int_of_uchar1
  {c} (c) = __cast (c) where {
  extern castfn __cast (c: uchar c):<> g1int (tk, c)
} // end of [g1int_of_uchar1]

implement{tk}
g1uint_of_uchar1
  {c} (c) = __cast (c) where {
  extern castfn __cast (c: uchar c):<> g1uint (tk, c)
} // end of [g1uint_of_uchar1]

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

implement
{}(*tmp*)
char2string(c) =
$effmask_wrt
(
  $UN.castvwtp0{string}(char2strptr(c))
) (* end of [char2string] *)
implement
{}(*tmp*)
char2strptr(c) = let
//
#define BSZ 16
//
typedef
cstring = $extype"atstype_string"
//
var buf = @[byte][BSZ]()
val bufp = $UN.cast{cstring}(addr@buf)
//
val _(*int*) =
  $extfcall(ssize_t, "snprintf", bufp, BSZ, "%c", c)
//
in
  $UN.castvwtp0{Strptr1}(string0_copy($UN.cast{string}(bufp)))
end // end of [char2strptr]

(* ****** ****** *)
//
implement fprint_val<char> = fprint_char
implement fprint_val<uchar> = fprint_uchar
implement fprint_val<schar> = fprint_schar
//
(* ****** ****** *)

(* end of [char.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/float.atxt
** Time of generation: Fri Aug 18 03:29:58 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: Feburary, 2012 *)

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

#define ATS_DYNLOADFLAG 0 // no dynloading at run-time

(* ****** ****** *)
//
(* ****** ****** *)
//
staload UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)


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

implement
g0int2float<intknd,fltknd> = g0int2float_int_float
implement
g0int2float<intknd,dblknd> = g0int2float_int_double
implement
g0int2float<lintknd,dblknd> = g0int2float_lint_double

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

implement
g0float2int<fltknd, intknd> = g0float2int_float_int
implement
g0float2int<fltknd, lintknd> = g0float2int_float_lint
implement
g0float2int<dblknd, intknd> = g0float2int_double_int
implement
g0float2int<dblknd, lintknd> = g0float2int_double_lint
implement
g0float2int<dblknd, llintknd> = g0float2int_double_llint

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

implement
g0float2float<fltknd,fltknd> = g0float2float_float_float
implement
g0float2float<fltknd,dblknd> = g0float2float_float_double
implement
g0float2float<dblknd,fltknd> = g0float2float_double_float
implement
g0float2float<dblknd,dblknd> = g0float2float_double_double

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

implement g0string2float<dblknd> = g0string2float_double

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

implement g0float_neg<fltknd> = g0float_neg_float
implement g0float_abs<fltknd> = g0float_abs_float
implement g0float_succ<fltknd> = g0float_succ_float
implement g0float_pred<fltknd> = g0float_pred_float

implement g0float_add<fltknd> = g0float_add_float
implement g0float_sub<fltknd> = g0float_sub_float
implement g0float_mul<fltknd> = g0float_mul_float
implement g0float_div<fltknd> = g0float_div_float
implement g0float_mod<fltknd> = g0float_mod_float

implement g0float_lt<fltknd> = g0float_lt_float
implement g0float_lte<fltknd> = g0float_lte_float
implement g0float_gt<fltknd> = g0float_gt_float
implement g0float_gte<fltknd> = g0float_gte_float
implement g0float_eq<fltknd> = g0float_eq_float
implement g0float_neq<fltknd> = g0float_neq_float
implement g0float_compare<fltknd> = g0float_compare_float

implement g0float_max<fltknd> = g0float_max_float
implement g0float_min<fltknd> = g0float_min_float

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

implement g0float_neg<dblknd> = g0float_neg_double
implement g0float_abs<dblknd> = g0float_abs_double
implement g0float_succ<dblknd> = g0float_succ_double
implement g0float_pred<dblknd> = g0float_pred_double

implement g0float_add<dblknd> = g0float_add_double
implement g0float_sub<dblknd> = g0float_sub_double
implement g0float_mul<dblknd> = g0float_mul_double
implement g0float_div<dblknd> = g0float_div_double
implement g0float_mod<dblknd> = g0float_mod_double

implement g0float_lt<dblknd> = g0float_lt_double
implement g0float_lte<dblknd> = g0float_lte_double
implement g0float_gt<dblknd> = g0float_gt_double
implement g0float_gte<dblknd> = g0float_gte_double
implement g0float_eq<dblknd> = g0float_eq_double
implement g0float_neq<dblknd> = g0float_neq_double
implement g0float_compare<dblknd> = g0float_compare_double

implement g0float_max<dblknd> = g0float_max_double
implement g0float_min<dblknd> = g0float_min_double

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

implement g0float_neg<ldblknd> = g0float_neg_ldouble
implement g0float_abs<ldblknd> = g0float_abs_ldouble
implement g0float_succ<ldblknd> = g0float_succ_ldouble
implement g0float_pred<ldblknd> = g0float_pred_ldouble

implement g0float_add<ldblknd> = g0float_add_ldouble
implement g0float_sub<ldblknd> = g0float_sub_ldouble
implement g0float_mul<ldblknd> = g0float_mul_ldouble
implement g0float_div<ldblknd> = g0float_div_ldouble
implement g0float_mod<ldblknd> = g0float_mod_ldouble

implement g0float_lt<ldblknd> = g0float_lt_ldouble
implement g0float_lte<ldblknd> = g0float_lte_ldouble
implement g0float_gt<ldblknd> = g0float_gt_ldouble
implement g0float_gte<ldblknd> = g0float_gte_ldouble
implement g0float_eq<ldblknd> = g0float_eq_ldouble
implement g0float_neq<ldblknd> = g0float_neq_ldouble
implement g0float_compare<ldblknd> = g0float_compare_ldouble

implement g0float_max<ldblknd> = g0float_max_ldouble
implement g0float_min<ldblknd> = g0float_min_ldouble

(* ****** ****** *)
//
implement fprint_val<float> = fprint_float
implement fprint_val<double> = fprint_double
implement fprint_val<ldouble> = fprint_ldouble
//
(* ****** ****** *)

implement
{tk}(*tk*)
g0float_npow
  (x, n) = let
//
typedef gfloat = g0float(tk)
//
fun
loop
(
  x: gfloat, res: gfloat, n: int
) : gfloat = (
//
if
(n > 1)
then let
  val n2 = n >> 1
  val b0 = n - (n2 << 1)
  val xx = x * x
in
  if b0 = 0
    then loop(xx, res, n2) else loop(xx, x * res, n2)
  // end of [if]
end // end of [then]
else (
  if n > 0 then x * res else res
) (* end of [else] *)
//
) (* end of [loop] *)
//
val res = $UN.cast{gfloat}(1.0)
//
in
  $effmask_all(loop(x, res, n))
end // end of [g0float_npow]

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

(* end of [float.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/string.atxt
** Time of generation: Fri Aug 18 03:29:59 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: April, 2012 *)

(* ****** ****** *)
//
// HX:
#define // there is no need
ATS_DYNLOADFLAG 0 // for dynloading
//
(* ****** ****** *)
//
staload UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)

#define CNUL '\000'

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

overload + with add_ptr_bsz

(* ****** ****** *)
//
// HX:
// castvwtp_trans: formerly used name
//
macdef castvwtp_trans = $UN.castvwtp0
//
(* ****** ****** *)
//
extern
fun
memcpy
( d0: ptr
, s0: ptr
, n0: size_t
) :<!wrt> ptr = "mac#atspre_string_memcpy"
// end of [memcpy]
//
(* ****** ****** *)
//
implement
{}(*tmp*)
string_char(str) =
  $UN.ptr0_get<char>(string2ptr(str))
//
(* ****** ****** *)

implement
{}(*tmp*)
string_nil() = let
//
val (pfat, pfgc | p0) = malloc_gc(i2sz(1))
val ((*void*)) = $UN.ptr0_set<char> (p0, '\000')
//
in
  $UN.castvwtp0{strnptr(0)}((pfat, pfgc | p0))
end // end of [string_nil]

implement
{}(*tmp*)
string_sing(chr) = let
//
val (pfat, pfgc | p0) = malloc_gc(i2sz(2))
val ((*void*)) = $UN.ptr0_set<char> (p0, chr)
val ((*void*)) = $UN.ptr0_set_at<char> (p0, 1, '\000')
//
in
  $UN.castvwtp0{strnptr(1)}((pfat, pfgc | p0))
end // end of [string_sing]

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

implement
{}(*tmp*)
string_is_empty
  {n}(str) = let
//
val p = string2ptr(str)
//
in
  $UN.cast{bool(n==0)}($UN.ptr1_get<char>(p) = CNUL)
end // end of [string_is_empty]
implement{}
string_isnot_empty
  {n}(str) = let
//
val p = string2ptr(str)
//
in
  $UN.cast{bool(n > 0)}($UN.ptr1_get<char>(p) != CNUL)
end // end of [string_isnot_empty]

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

implement
{}(*tmp*)
string_is_atend_size
  {n}{i}(str, i) = let
//
val p_i =
  add_ptr_bsz(string2ptr(str), i)
//
in
  $UN.cast{bool(n==i)}($UN.ptr1_get<char>(p_i) = CNUL)
end // end of [string_is_atend_size]

implement
{tk}(*tmp*)
string_is_atend_gint(str, i) =
  string_is_atend_size(str, g1int2uint(i))
// end of [string_is_atend_gint]
implement
{tk}(*tmp*)
string_is_atend_guint(str, i) =
  string_is_atend_size(str, g1uint2uint(i))
// end of [string_is_atend_guint]

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

implement
{}(*tmp*)
string_get_at_size(str, i) =
  $UN.ptr1_get<charNZ>(string2ptr(str)+i)
// end of [string_get_at_size]

implement
{tk}(*tmp*)
string_get_at_gint(str, i) =
  string_get_at_size(str, g1int2uint(i))
// end of [string_get_at_gint]
implement
{tk}(*tmp*)
string_get_at_guint(str, i) =
  string_get_at_size(str, g1uint2uint(i))
// end of [string_get_at_guint]

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

implement
{}(*tmp*)
string_test_at_size
  {n}{i}(str, i) = let
//
extern
castfn
__cast
(
  c: char
) :<>
[c:int]
(
  string_index_p(n, i, c) | char(c)
)
//
in
//
__cast
(
  $UN.ptr1_get<char>(string2ptr(str)+i)
) (* __cast *)
//
end // end of [string_test_at_size]

implement
{tk}(*tmp*)
string_test_at_gint (str, i) =
  string_test_at_size (str, g1int2uint(i))
// end of [string_test_at_gint]
implement
{tk}(*tmp*)
string_test_at_guint (str, i) =
  string_test_at_size (str, g1uint2uint(i))
// end of [string_test_at_guint]

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

implement
{}(*tmp*)
strcmp(x1, x2) = let
//
extern
fun
__strcmp
(
  x1: string, x2: string
) :<> int = "mac#atspre_strcmp"
//
in
  __strcmp(x1, x2)
end // end of [let] // end of [strcmp]

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

implement
{}(*tmp*)
strintcmp
  {n1,n2}(x1, n2) = let
//
prval() =
  lemma_string_param (x1)
//
fun loop
  {n2:nat} .<n2>.
(
  p1: ptr, n2: int n2
) :<> int = let
//
  val c = $UN.ptr0_get<char>(p1)
//
in
//
if
c != CNUL
then (
  if n2 > 0
    then loop (ptr_succ<char>(p1), n2-1)
    else 1(*gt*)
  // end of [if]
) else (
  if n2 > 0 then ~1(*lt*) else 0(*eq*)
) (* end of [else] *)
//
end // end of [loop]
//
in
  $UN.cast{int(sgn(n1-n2))}(loop (string2ptr(x1), n2))
end // end of [strintcmp]

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

implement
{}(*tmp*)
strlencmp
  {n1,n2}(x1, x2) = let
//
prval () = lemma_string_param (x1)
prval () = lemma_string_param (x2)
//
//
fun loop
  {n1:nat} .<n1>. (
  p1: ptr, p2: ptr
) :<> int = let
//
val c1 = $UN.ptr0_get<char>(p1)
val c2 = $UN.ptr0_get<char>(p2)
//
in
//
if
c1 != CNUL
then let
  prval () =
  __assert () where
  {
      extern praxi __assert (): [n1 > 0] void
  } (* end of [prval] *)
in
  if c2 != CNUL
    then (
      loop{n1-1}(ptr_succ<char>(p1), ptr_succ<char>(p2))
    ) else 1(*gt*) // end of [else]
  // end of [if]
end else (
  if c2 != CNUL then ~1(*lt*) else 0(*eq*)
) (* end of [if] *)
//
end // end of [loop]
//
in
  $UN.cast{int(sgn(n1-n2))}(loop{n1}(string2ptr(x1), string2ptr(x2)))
end // end of [strlencmp]

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

implement
{}(*tmp*)
string_make_list(cs) =
  string_make_listlen(cs, list_length(cs))
// end of [string_make_list]

implement
{}(*tmp*)
string_make_listlen
  {n}(cs, n) = let
//
prval () = lemma_list_param (cs)
//
fun loop
  {n:nat} .<n>.
(
  cs: list (char, n), n: int n, p: ptr
) :<!wrt> ptr = let
in
  if n > 0 then let
    val+list_cons (c, cs) = cs
    val () = $UN.ptr0_set<char>(p, c)
  in
    loop (cs, n-1, ptr_succ<char>(p))
  end else p // end of [if]
end // end of [loop]
//
val n1 = n + 1
//
val (pf, pfgc | p0) =
  $effmask_wrt (malloc_gc(i2sz(n1)))
//
val p1 = $effmask_wrt(loop(cs, n, p0))
//
val () =
  $effmask_wrt ($UN.ptr0_set<char>(p1, CNUL))
//
in
  castvwtp_trans{strnptr(n)}((pf, pfgc | p0))
end // end of [string_make_listlen]

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

implement
{}(*tmp*)
string_make_rlist(cs) =
  string_make_rlistlen(cs, list_length(cs))
// end of [string_make_rlist]

implement
{}(*tmp*)
string_make_rlistlen
  {n}(cs, n) = let
//
prval() = lemma_list_param (cs)
//
fun loop
  {n:nat} .<n>.
(
  cs: list(char, n), n: int n, p: ptr
) :<!wrt> ptr = let
in
//
if
n > 0
then let
  val p1 = ptr_pred<char>(p)
  val+list_cons (c, cs) = cs
  val () = $UN.ptr0_set<char>(p1, c)
in
  loop (cs, n-1, p1)
end // end of [then]
else (p) // end of [else]
//
end // end of [loop]
//
val n1 = n + 1
//
val
(pf, pfgc | p0) =
$effmask_wrt(malloc_gc(i2sz(n1)))
//
val p1 = ptr_add<char>(p0, n)
val () =
$effmask_wrt
  ($UN.ptr0_set<char>(p1, CNUL))
//
val p0 = $effmask_wrt(loop(cs, n, p1))
//
in
  castvwtp_trans{strnptr(n)}((pf, pfgc | p0))
end // end of [string_make_rlistlen]

(* ****** ****** *)
//
implement
{}(*tmp*)
string_make_list_vt
  (cs) = let
//
val n = list_vt_length(cs)
//
in
  string_make_listlen_vt(cs, n)
end (* end of [string_make_list_vt] *)
//
implement
{}(*tmp*)
string_make_listlen_vt
  (cs, n) = str where
{
//
  val cs2 = $UN.list_vt2t(cs)
  val str = string_make_listlen(cs2, n)
  val ((*freed*)) = list_vt_free<char>(cs)
//
} (* end of [string_make_listlen_vt] *)
//
(* ****** ****** *)
//
implement
{}(*tmp*)
string_make_rlist_vt
  (cs) = let
//
val n = list_vt_length(cs)
//
in
  string_make_rlistlen_vt(cs, n)
end (* end of [string_make_rlist_vt] *)
//
implement
{}(*tmp*)
string_make_rlistlen_vt
  (cs, n) = str where
{
//
  val cs2 = $UN.list_vt2t(cs)
  val str = string_make_rlistlen(cs2, n)
  val ((*freed*)) = list_vt_free<char>(cs)
//
} (* end of [string_make_rlistlen_vt] *)
//
(* ****** ****** *)

implement
{}(*tmp*)
string_make_substring
  {n}{st,ln}
  (str, st, ln) = $effmask_wrt let
//
val ln1 = succ(ln)
val (pf, pfgc | p_dst) = malloc_gc(ln1)
//
val
p_src = string2ptr(str)
val
p_dst = memcpy(p_dst, p_src + st, ln)
//
val () = $UN.ptr0_set<char>(p_dst + ln, CNUL)
//
in
  castvwtp_trans{strnptr(ln)}((pf, pfgc | p_dst))
end // end of [string_make_substring]

(* ****** ****** *)
//
implement
string_make_stream$bufsize<> ((*void*)) = 16
//
(* ****** ****** *)

implement
{}(*tmp*)
string_make_stream
  (cs) = let
//
fun
loop
{l:addr}
{n:int}
{i:nat | i <= n}
(
  pf: b0ytes(n)@l, fpf: mfree_gc_v(l)
| cs: stream(charNZ), p0: ptr(l), pi: ptr, n: size_t(n), i: size_t(i)
) : Strptr1 = (
if
(i < n)
then
(
case+ !cs of
| stream_nil() => let
    val () =
    $UN.ptr0_set<char>(pi, CNUL)
  in
    $UN.castvwtp0((pf, fpf | p0))
  end // end of [stream_nil]
| stream_cons(c, cs) => let
    val () = $UN.ptr0_set<char>(pi, c)
  in
    loop(pf, fpf | cs, p0, ptr_succ<char>(pi), n, succ(i))
  end // end of [stream_cons]
)
else let
//
  val n2 = n + n
  val (pf2, fpf2 | p02) = malloc_gc(n2)
//
  val _(*p02*) = memcpy(p02, p0, i)
  val ((*freed*)) = mfree_gc(pf, fpf | p0)
//
in
  loop(pf2, fpf2 | cs, p02, ptr_add<char>(p02, i), n2, i)
end // end of [
) (* end of [loop] *)
//
val n0 =
string_make_stream$bufsize<>()
//
val n0 = i2sz(n0)
val (pf, fpf | p0) = malloc_gc(n0)
//
in
  $effmask_all(loop(pf, fpf | cs, p0, p0, n0, i2sz(0)))
end // end of [string_make_stream]

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

implement
{}(*tmp*)
string_make_stream_vt
  (cs) = let
//
fun
loop
{l:addr}
{n:int}
{i:nat | i <= n}
(
  pf: b0ytes(n)@l, fpf: mfree_gc_v(l)
| cs: stream_vt(charNZ), p0: ptr(l), pi: ptr, n: size_t(n), i: size_t(i)
) : Strptr1 = (
if
(i < n)
then
(
case+ !cs of
| ~stream_vt_nil() => let
    val () =
    $UN.ptr0_set<char>(pi, CNUL)
  in
    $UN.castvwtp0((pf, fpf | p0))
  end // end of [stream_nil]
| ~stream_vt_cons(c, cs) => let
    val () = $UN.ptr0_set<char>(pi, c)
  in
    loop(pf, fpf | cs, p0, ptr_succ<char>(pi), n, succ(i))
  end // end of [stream_cons]
)
else let
//
  val n2 = n + n
  val (pf2, fpf2 | p02) = malloc_gc(n2)
//
  val _(*p02*) = memcpy(p02, p0, i)
  val ((*freed*)) = mfree_gc(pf, fpf | p0)
//
in
  loop(pf2, fpf2 | cs, p02, ptr_add<char>(p02, i), n2, i)
end // end of [
) (* end of [loop] *)
//
val n0 =
string_make_stream$bufsize<>()
//
val n0 = i2sz(n0)
val (pf, fpf | p0) = malloc_gc(n0)
//
in
  $effmask_all(loop(pf, fpf | cs, p0, p0, n0, i2sz(0)))
end // end of [string_make_stream_vt]

(* ****** ****** *)
//
implement
{}(*tmp*)
string_head
  (str) = $UN.ptr0_get<charNZ>(string2ptr(str))
implement
{}(*tmp*)
string_tail
  {n}(str) =
(
  $UN.cast{string(n-1)}(ptr_succ<char>(string2ptr(str)))
)
//
(* ****** ****** *)

implement
{}(*tmp*)
string0_length
  (str) = string1_length<>(g1ofg0(str))
// end of [string0_length]

implement
{}(*tmp*)
string1_length
  {n}(str) =
  __strlen (str) where
{
  extern
  fun
  __strlen (string(n)):<> size_t(n) = "mac#atspre_strlen"
} // end of [where] // end of [string1_length]

(* ****** ****** *)
//
implement
{}(*tmp*)
string0_nlength
  (str1, n2) =
  string1_nlength<> (g1ofg0(str1), g1ofg0(n2))
// end of [string0_nlength]
//
implement
{}(*tmp*)
string1_nlength
  (str1, n2) = let
//
fun
loop{n1,n2,r:nat} .<n1>.
(
  str1: string(n1), n2: size_t(n2), r: size_t(r)
) :<> size_t(min(n1,n2)+r) = (
//
if
(n2 > 0)
then (
//
if
isneqz(str1)
then loop(str1.tail(), pred(n2), succ(r)) else (r)
//
) (* end of [then] *)
else (r) // end of [else]
//
) (* end of [loop] *)
//
prval () =
  lemma_string_param(str1)
//
prval () = lemma_g1uint_param(n2)
//
in
  loop (str1, n2, i2sz(0))
end // end of [string1_nlength]
//
(* ****** ****** *)

implement
{}(*tmp*)
string0_copy
  (str) = let
//
val str = g1ofg0(str)
val str2 = string1_copy(str)
//
prval () = lemma_strnptr_param(str2)
//
in
  strnptr2strptr(str2)
end // end of [string0_copy]

implement
{}(*tmp*)
string1_copy
  {n}(str) = let
//
val n =
string1_length(str)
val n1 = g1uint_succ(n)
val (pf, pfgc | p) = malloc_gc(n1)
//
val _(*p*) =
$effmask_wrt(memcpy(p, string2ptr(str), n1))
//
in
  castvwtp_trans{strnptr(n)}((pf, pfgc | p))
end // end of [string1_copy]

(* ****** ****** *)
//
implement
{}(*tmp*)
string_fset_at_size
  (s0, i, c) = let
  val s1 = string1_copy(s0)
in
//
let val () = s1[i] := c in strnptr2string(s1) end
//
end // end of [string_fset_at_size]
//
(* ****** ****** *)

implement
{}(*tmp*)
strchr{n}(str, c0) = let
//
prval () = lemma_string_param(str)
extern
fun __strchr__(string, int):<> ptr = "mac#atspre_strchr"
extern
fun sub_ptr_ptr(ptr, ptr):<> ssizeBtw(0, n) = "mac#atspre_sub_ptr_ptr"
//
val p0 = string2ptr(str)
val p1 = __strchr__(str, (char2int0)c0)
//
in
  if p1 > the_null_ptr then sub_ptr_ptr(p1, p0) else i2ssz(~1)
end // end of [strchr]

implement
{}(*tmp*)
strrchr{n}(str, c0) = let
//
prval () = lemma_string_param (str)
extern
fun __strrchr__(string, int):<> ptr = "mac#atspre_strrchr"
extern
fun sub_ptr_ptr(ptr, ptr):<> ssizeBtw(0, n) = "mac#atspre_sub_ptr_ptr"
//
val p0 = string2ptr(str)
val p1 = __strrchr__(str, (char2int0)c0)
//
in
  if p1 > the_null_ptr then sub_ptr_ptr(p1, p0) else i2ssz(~1)
end // end of [strrchr]

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

implement
{}(*tmp*)
strstr{n}
  (haystack, needle) = let
//
prval () = lemma_string_param (haystack)
//
extern
fun __strstr__(string, string):<> ptr = "mac#atspre_strstr"
extern
fun sub_ptr_ptr(ptr, ptr):<> ssizeBtw(0, n) = "mac#atspre_sub_ptr_ptr"
//
val p0 = string2ptr(haystack)
val p1 = __strstr__(haystack, needle)
//
in
  if p1 > the_null_ptr then sub_ptr_ptr(p1, p0) else i2ssz(~1)
end // end of [strstr]

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

implement
{}(*tmp*)
strspn{n}
(subject, accept) = let
//
prval () = lemma_string_param(subject)
//
extern
fun
__strspn__(string, string):<> sizeLte(n) = "mac#atspre_strspn"
//
in
  __strspn__(subject, accept)
end // end of [strspn]

implement
{}(*tmp*)
strcspn{n}
(subject, reject) = let
//
prval() = lemma_string_param(subject)
//
extern
fun
__strcspn__(string, string):<> sizeLte(n) = "mac#atspre_strcspn"
//
in
  __strcspn__(subject, reject)
end // end of [strcspn]

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

implement
{}(*tmp*)
string_index
  {n}(str, c) = $UN.cast{ssizeBtw(~1,n)}(strchr(str, c))
// end of [string_index]

implement
{}(*tmp*)
string_rindex
  {n}(str, c) = $UN.cast{ssizeBtw(~1,n)}(strrchr(str, c))
// end of [string_rindex]

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

implement
{}(*tmp*)
string0_append
  (x1, x2) = let
//
val x1 = g1ofg0(x1)
val x2 = g1ofg0(x2)
val x12 = string1_append(x1, x2)
prval () = lemma_strnptr_param(x12)
//
in
  strnptr2strptr (x12)
end // end of [string0_append]

implement
{}(*tmp*)
string1_append
  {n1,n2}(x1, x2) = let
//
val n1 = strlen(x1) and n2 = strlen(x2)
//
val n12 = n1 + n2
val (pf, fpf | p) = malloc_gc(succ(n12))
//
val p1 = memcpy(p, string2ptr(x1), n1)
val p2 = memcpy(p + n1, string2ptr(x2), succ(n2))
//
in
  castvwtp_trans{strnptr(n1+n2)}((pf, fpf | p))
end // end of [string1_append]

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

implement
{}(*tmp*)
string0_append3
  (x1, x2, x3) = let
//
var xs = @[string](x1, x2, x3)
//
in
//
stringarr_concat<>
  ($UN.cast{arrayref(string,3)}(addr@xs), i2sz(3))
//
end // end of [string0_append3]

implement
{}(*tmp*)
string0_append4
  (x1, x2, x3, x4) = let
//
var xs = @[string](x1, x2, x3, x4)
//
in
//
stringarr_concat<>
  ($UN.cast{arrayref(string,4)}(addr@xs), i2sz(4))
//
end // end of [string0_append4]

implement
{}(*tmp*)
string0_append5
  (x1, x2, x3, x4, x5) = let
//
var xs = @[string](x1, x2, x3, x4, x5)
//
in
//
stringarr_concat<>
  ($UN.cast{arrayref(string,5)}(addr@xs), i2sz(5))
//
end // end of [string0_append5]

implement
{}(*tmp*)
string0_append6
  (x1, x2, x3, x4, x5, x6) = let
//
var xs = @[string](x1, x2, x3, x4, x5, x6)
//
in
//
stringarr_concat<>
  ($UN.cast{arrayref(string,6)}(addr@xs), i2sz(6))
//
end // end of [string0_append6]

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

implement
{}(*tmp*)
stringarr_concat
  (xs, asz) = let
//
fun loop
(
  p1: ptr, p2: ptr, i: size_t, ntot: size_t
) : size_t = let
in
//
if
i > 0
then let
  val x = $UN.ptr0_get<string>(p1)
  val nx: size_t = string_length(x)
  val () = $UN.ptr0_set<size_t>(p2, nx)
in
  loop(ptr_succ<string>(p1), ptr_succ<size_t>(p2), pred(i), ntot+nx)
end // end of [then]
else ntot // end of [else]
//
end // end of [loop]
//
fun loop2
(
  p1: ptr, p2: ptr, i: size_t, pres: ptr
) : void = let
in
//
if
i > 0
then let
//
val x = $UN.ptr0_get<string>(p1)
val nx = $UN.ptr0_get<size_t>(p2)
val _(*ptr*) = memcpy(pres, $UN.cast{ptr}(x), nx)
//
in
  loop2(ptr_succ<string>(p1), ptr_succ<size_t>(p2), pred(i), pres+nx)
end // end of [then]
else
(
  $UN.ptr0_set<char>(pres, CNUL)
)
//
end // end of [loop2]
//
val p1 =
  $UN.cast{ptr}(xs)
//
val A0 =
  arrayptr_make_uninitized<size_t>(asz)
//
val p2 = arrayptr2ptr(A0)
//
val ntot =
  $effmask_all(loop(p1, p2, asz, i2sz(0)))
//
val
( pf
, pfgc
| pres
) = malloc_gc(g1ofg0(succ(ntot)))
//
val ((*void*)) =
  $effmask_all(loop2(p1, p2, asz, pres))
//
val ((*freed*)) = arrayptr_free{size_t?}(A0)
//
in
  castvwtp_trans{Strptr1}((pf, pfgc | pres))
end // end of [stringarr_concat]

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

implement
{}(*tmp*)
stringlst_concat
  (xs) = res where
{
//
val n = list_length(xs)
//
prval() = lemma_list_param(xs)
//
prval
[n:int]
EQINT() = eqint_make_gint(n)
typedef
stringarr = arrayref(string,n)
//
val xs2 = arrayptr_make_list (n, xs)
//
val res =
stringarr_concat
  ($UN.castvwtp1{stringarr}(xs2), i2sz(n))
//
val ((*freed*)) = arrayptr_free{string}(xs2)
//
} (* end of [stringlst_concat] *)

(* ****** ****** *)
//
implement
{}(*tmp*)
string_implode
  (cs) = string_make_list<>(cs)
//
(* ****** ****** *)

implement
{}(*tmp*)
string_explode
  {n}(x0) = let
//
prval () = lemma_string_param(x0)
//
viewtypedef res(n) = list_vt(charNZ, n)
//
fun loop
  {n:nat} .<n>.
(
  x0: string(n)
, res: &ptr? >> res(n)
) :<!wrt> void = let
  val p = string2ptr(x0)
  val c = $UN.ptr1_get<Char>(p)
in
//
if
(c != CNUL)
then let
  prval() =
  __assert () where
  {
    extern
    praxi __assert (): [n > 0] void
  } (* prval *)
  val () =
    res :=
    list_vt_cons{charNZ}{0}(c, _)
  // end of [val]
  val+list_vt_cons (_, res1) = res
  val x1 =
    $UN.cast{string(n-1)}(ptr1_succ<char>(p))
  // end of [val]
  val ((*void*)) = loop (x1, res1)
in
  fold@(res)
end // end of [then]
else let
  prval() =
  __assert () where
  {
    extern
    praxi __assert (): [n == 0] void
  } (* [prval] *)
in
  res := list_vt_nil((*void*))
end // end of [else]
//
end // end of [loop]
//
var res: ptr
val () = $effmask_wrt(loop(x0, res))
//
in
  res
end // end of [string_explode]

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

implement
{}(*tmp*)
string_tabulate{n}(n) = let
//
prval () =
lemma_g1uint_param(n)
//
fun
loop
(
 p: ptr, n: size_t, i: size_t
) : void = let
in
//
if
(i < n)
then let
  val c =
  string_tabulate$fopr(i)
  val () =
  $UN.ptr0_set<char>(p, c)
in
  loop(ptr_succ<char>(p), n, succ(i))
end else
  $UN.ptr0_set<char> (p, CNUL)
// end of [if]
//
end // end of [loop]
//
val n1 = succ(n)
val (pf, fpf | p0) = malloc_gc(n1)
val () = loop (p0, n, g1int2uint(0))
//
in
  castvwtp_trans{strnptr(n)}((pf, fpf | p0))
end // end of [string_tabulate]

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

implement
{}(*tmp*)
string_tabulate_cloref
  {n}(n, fopr) = let
//
implement
string_tabulate$fopr<>(i) = fopr($UN.cast{sizeLt(n)}(i))
//
in
  string_tabulate<>(n)
end // end of [string_tabulate_cloref]

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

implement
{}(*tmp*)
string_forall
  (str) = let
//
fun
loop
(
  p: ptr
) : bool = let
  val c0 = $UN.ptr0_get<char>(p)
in
//
if
c0 = CNUL
then true else
(
  if string_forall$pred(c0) then loop(ptr0_succ<char>(p)) else false
) (* end of [if] *)
//
end // end of [loop]
//
in
  loop(string2ptr(str))
end // end of [string_forall]

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

implement
{}(*tmp*)
string_iforall
  (str) = let
//
fun
loop
(
  i: int, p: ptr
) : bool = let
  val c0 = $UN.ptr0_get<char>(p)
in
//
if
c0 = CNUL
then true else
(
  if string_iforall$pred(i, c0) then loop(i+1, ptr0_succ<char>(p)) else false
) (* end of [if] *)
//
end // end of [loop]
//
in
  loop(0, string2ptr(str))
end // end of [string_iforall]

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

implement
{env}
string_foreach$cont(c, env) = true
implement{env}
string_foreach$fwork(c, env) = ((*void*))

implement
{}(*tmp*)
string_foreach(str) = let
  var env: void = () in string_foreach_env(str, env)
end // end of [string_foreach]

implement
{env}
string_foreach_env
  {n}(str, env) = let
//
fun loop (
  p: ptr, env: &env
) : ptr = let
  val c = $UN.ptr0_get<char> (p)
  val cont = (
    if c != CNUL
      then string_foreach$cont<env> (c, env) else false
    // end of [if]
  ) : bool // end of [val]
in
  if cont then let
    val () =
      string_foreach$fwork<env> (c, env) in loop(ptr_succ<char> (p), env)
    // end of [val]
  end else (p) // end of [if]
end // end of [fun]
//
val p0 =
  string2ptr (str)
val p1 = loop (p0, env)
//
in
  $UN.cast{sizeLte(n)}(p1 - p0)
end // end of [string_foreach_env]

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

implement
{env}
string_rforeach$cont (c, env) = true
implement
{env}
string_rforeach$fwork (c, env) = ((*void*))

implement
{}(*tmp*)
string_rforeach(str) = let
  var env: void = () in string_rforeach_env(str, env)
end // end of [string_rforeach]

implement
{env}(*tmp*)
string_rforeach_env
  {n}(str, env) = let
//
fun loop
(
  p0: ptr, p1: ptr, env: &env >> _
) : ptr = let
in
//
if
(p1 > p0)
then let
  val p2 = ptr_pred<char> (p1)
  val c2 = $UN.ptr0_get<charNZ> (p2)
  val cont =
    string_rforeach$cont<env> (c2, env)
  // end of [val]
in
  if cont
    then let
      val () =
      string_rforeach$fwork<env> (c2, env)
    in
      loop (p0, p2, env)
    end // end of [then]
    else (p1) // end of [else]    
end // end of [then]
else (p1) // end of [else]
//
end // end of [loop]
//
val p0 = ptrcast(str)
val p1 = ptr_add<char> (p0, length(str))
//
in
  $UN.cast{sizeLte(n)}(p1 - loop (p0, p1, env))
end // end of [string_rforeach_env]

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

implement
{}(*tmp*)
streamize_string_char
  (str) = let
//
typedef elt = charNZ
//
fun
auxmain
(
  p: ptr
) : stream_vt(elt) = $ldelay(
//
let
//
val c0 = $UN.ptr0_get<Char>(p)
//
in
//
if
isneqz(c0)
then (
  stream_vt_cons(c0, auxmain(ptr0_succ<Char>(p)))
) else stream_vt_nil((*void*))
//
end : stream_vt_con(elt) // end of [let]
) (* end of [auxmain] *)
//
in
  auxmain(string2ptr(str))
end // end of [streamize_string_char]

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

(*
//
// HX-2013-03: it is now defined as a macro
//
implement
stropt_none () = $UN.cast{stropt(~1)}(the_null_ptr)
*)

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

implement
{}(*tmp*)
stropt_is_none{n}(x) =
(
  $UN.cast{bool(n < 0)}(ptr0_is_null($UN.cast2ptr(x)))
) // end of [stropt_is_none]

implement
{}(*tmp*)
stropt_is_some{n}(x) =
(
  $UN.cast{bool(n>=0)}(ptr0_isnot_null($UN.cast2ptr(x)))
) // end of [stropt_is_some]

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

implement
{}(*tmp*)
stropt_length (x) = let
//
prval() = lemma_stropt_param(x)
//
in
//
if
stropt_is_some(x)
then g1uint2int(string1_length(stropt_unsome(x))) else i2ssz(~1)
//
end // end of [stropt_length]

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

implement fprint_val<string> = fprint_string
implement fprint_val<stropt> = fprint_stropt

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

%{$
//
atstype_string
atspre_string_make_snprintf
(
  atstype_string fmt, ...
) {
  char *res ;
  va_list ap0 ;
//
  va_start(ap0, fmt) ;
//
// HX: [8] is kind of random
//
  res =
  atspre_string_make_vsnprintf(8, fmt, ap0) ;
//
  va_end(ap0) ;
//
  return (res) ;
//
} // end of [atspre_string_make_snprintf]
//
atstype_string
atspre_string_make_vsnprintf
(
  atstype_size bsz
, atstype_string fmt, va_list ap0
) {
//
  int ntot ;
  char *res ;
  va_list ap1 ;
//
  res = atspre_malloc_gc(bsz) ;
//
  va_copy(ap1, ap0) ;
  ntot = vsnprintf(res, bsz, (char*)fmt, ap1) ;
  va_end(ap1) ;
//
  if (ntot >= bsz)
  {
    bsz = ntot + 1 ;
    res = atspre_realloc_gc(res, bsz) ;
    ntot = vsnprintf(res, bsz, (char*)fmt, ap0) ;
  }
//
  if (ntot < 0) {
    atspre_mfree_gc(res) ; return (char*)0 ;
  }
//
  return (res) ;
//
} // end of [atspre_string_make_vsnprintf]
//
%}

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

(* end of [string.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/strptr.atxt
** Time of generation: Fri Aug 18 03:29:59 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: April, 2012 *)

(* ****** ****** *)
//
// HX:
#define // there is no need
ATS_DYNLOADFLAG 0 // for dynloading
//
(* ****** ****** *)

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

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

staload _(*anon*) = "prelude/DATS/integer.dats"

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

#define CNUL '\000'
#define nullp the_null_ptr

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

overload + with add_ptr_bsz

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

implement
{}(*tmp*)
strptr_is_null(str) = (strptr2ptr (str) = nullp)
implement
{}(*tmp*)
strptr_isnot_null(str) = (strptr2ptr (str) > nullp)

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

implement
{}(*tmp*)
strptr_is_empty(str) = let
  val p = strptr2ptr(str) in $UN.ptr1_get<char>(p) = CNUL
end // end of [strptr_is_empty]
implement
{}(*tmp*)
strptr_isnot_empty(str) = let
  val p = strptr2ptr(str) in $UN.ptr1_get<char>(p) != CNUL
end // end of [strptr_isnot_empty]

(* ****** ****** *)
//
implement
{}(*tmp*)
strnptr_get_at_size(str, i) =
  $UN.ptr0_get<charNZ>(strnptr2ptr(str)+i)
// end of [strnptr_get_at_size]
//
implement
{tk}(*tmp*)
strnptr_get_at_gint(str, i) =
  strnptr_get_at_size(str, g1int2uint(i))
// end of [strnptr_get_at_gint]
implement
{tk}(*tmp*)
strnptr_get_at_guint(str, i) =
  strnptr_get_at_size(str, g1uint2uint(i))
// end of [strnptr_get_at_guint]
//
(* ****** ****** *)
//
implement
{}(*tmp*)
strnptr_set_at_size(str, i, c) =
  $UN.ptr0_set<charNZ>(strnptr2ptr(str)+i, c)
// end of [strnptr_set_at_size]
//
implement
{tk}(*tmp*)
strnptr_set_at_gint(str, i, c) =
  strnptr_set_at_size (str, g1int2uint(i), c)
// end of [strnptr_set_at_gint]
implement
{tk}(*tmp*)
strnptr_set_at_guint(str, i, c) =
  strnptr_set_at_size(str, g1uint2uint(i), c)
// end of [strnptr_set_at_guint]
//
(* ****** ****** *)
//
implement
lt_strptr_strptr
  (x1, x2) =
(
  compare_strptr_strptr(x1, x2) < 0
)
implement
lte_strptr_strptr
  (x1, x2) =
(
  compare_strptr_strptr(x1, x2) <= 0
)
implement
gt_strptr_strptr
  (x1, x2) =
(
  compare_strptr_strptr(x1, x2) > 0
)
implement
gte_strptr_strptr
  (x1, x2) =
(
  compare_strptr_strptr(x1, x2) >= 0
)
implement
eq_strptr_strptr
  (x1, x2) =
(
  compare_strptr_strptr(x1, x2) = 0
)
implement
neq_strptr_strptr
  (x1, x2) =
(
  compare_strptr_strptr(x1, x2) != 0
)
//
(* ****** ****** *)

(*
//
// HX: implemented in [strptr.cats]
//
implement
print_strptr (x) = fprint_strptr (stdout_ref, x)
implement
prerr_strptr (x) = fprint_strptr (stderr_ref, x)
*)

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

implement
{}(*tmp*)
strnptr_is_null (str) = (strnptr2ptr (str) = nullp)
implement
{}(*tmp*)
strnptr_isnot_null (str) = (strnptr2ptr (str) > nullp)

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

implement
{}(*tmp*)
strptr_length(x) = let
  val isnot = ptr_isnot_null(strptr2ptr(x))
in
//
if isnot
  then g0u2i(string_length($UN.strptr2string(x)))
  else g0i2i(~1)
//
end // end of [strptr_length]

implement
{}(*tmp*)
strnptr_length(x) = let
  prval () = lemma_strnptr_param (x)
  val isnot = ptr_isnot_null(strnptr2ptr(x))
in
//
if isnot
  then g1u2i(string_length($UN.strnptr2string(x)))
  else g1i2i(~1)
//
end // end of [strnptr_length]

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

implement
{}(*tmp*)
strptr0_copy(x) = let
  val isnot = ptr_isnot_null(strptr2ptr(x))
in
//
if isnot
  then string0_copy($UN.strptr2string(x)) else strptr_null()
//
end // end of [strptr0_copy]

implement
{}(*tmp*)
strptr1_copy(x) = string0_copy($UN.strptr2string(x))

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

implement
{}(*tmp*)
strnptr_copy
  {n}(x) = x2 where
{
  val x = strnptr2ptr(x)
  val x = $UN.castvwtp0{Strptr0}(x)
  val x2 = $UN.castvwtp0{strnptr(n)}(strptr0_copy(x))
  prval ((*void*)) = $UN.cast2void(x)
} (* end of [strnptr_copy] *)

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

implement
{}(*tmp*)
strptr_append
  (x1, x2) = let
//
val
isnot1 =
ptr_isnot_null(strptr2ptr(x1))
//
in
//
if
isnot1
then let
//
val
isnot2 =
ptr_isnot_null(strptr2ptr(x2))
//
in
//
if (
isnot2
) then (
  strnptr2strptr(
    string1_append($UN.strptr2string(x1), $UN.strptr2string(x2))
  ) (*strnptr2strptr*)
) else strptr1_copy(x1)
// end of [if]
//
end else
(
  strptr0_copy(x2)
) (* end of [if] *)
//
end // end of [strptr_append]

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

implement
{}(*tmp*)
strptrlst_free (xs) = let
//
fun loop
  (xs: List_vt(Strptr0)): void = let
in
//
case+ xs of
| ~list_vt_cons
    (x, xs) => (strptr_free (x); loop (xs))
| ~list_vt_nil () => ()
//
end // end of [loop]
//
in
  $effmask_all (loop (xs))
end // end of [strptrlst_free]

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

implement
{}(*tmp*)
strptrlst_concat (xs) = let
//
prval () = lemma_list_vt_param (xs)
//
fun loop
  {n0:nat} .<n0>.
(
  xs: &list_vt(Strptr0, n0)>>list_vt(Strptr1, n1)
) :<!wrt> #[n1:nat | n1 <= n0] void = let
in
//
case+ xs of
| @list_vt_cons
    (x, xs1) => let
    val isnot = strptr_isnot_null (x)
  in
    if isnot then let
      val () = loop (xs1)
      prval () = fold@ (xs)
    in
      // nothing
    end else let
      prval () =
        strptr_free_null (x)
      val xs1 = xs1
      val () = free@{..}{0}(xs)
      val ((*void*)) = (xs := xs1)
    in
      loop (xs)
    end // end of [if]
  end // end of [list_vt_cons]
| @list_vt_nil () => fold@ (xs)
//
end // end of [loop]
//
var xs = xs
val () = loop (xs)
//
in
//
case+ xs of
| ~list_vt_nil () => strptr_null ()
| ~list_vt_cons (x, ~list_vt_nil ()) => x
| _ => let
    val res =
      stringlst_concat ($UN.castvwtp1{List(string)}(xs))
    val () =
    loop (xs) where {
      fun loop {n:nat} .<n>.
        (xs: list_vt (Strptr1, n)):<!wrt> void =
        case+ xs of
        | ~list_vt_cons (x, xs) => (strptr_free (x); loop (xs))
        | ~list_vt_nil ((*void*)) => ()
      // end of [loop]
    } // end of [where] // end of [val]
  in
    res
  end // end of [_]
//
end // end of [strptrlst_concat]

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

implement
{env}(*tmp*)
strnptr_foreach$cont (c, env) = true

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

implement
{}(*tmp*)
strnptr_foreach (str) = let
  var env: void = () in strnptr_foreach_env<void> (str, env)
end // end of [strnptr_foreach]

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

implement
{env}(*tmp*)
strnptr_foreach_env
  {n}(str, env) = let
//
fun loop
(
  p: ptr, env: &env >> _
) : ptr = let
//
#define NUL '\000'
//
val c = $UN.ptr0_get<Char> (p)
//
in
//
if
(c != NUL)
then let
  val (pf, fpf | p) =
    $UN.ptr0_vtake{charNZ}(p)
  val cont =
    strnptr_foreach$cont<env> (!p, env)
  // end of [val]
in
  if cont
    then let
      val () =
      strnptr_foreach$fwork<env> (!p, env)
      prval ((*void*)) = fpf (pf)
    in
      loop (ptr_succ<char> (p), env)
    end // end of [then]
    else let
      prval ((*void*)) = fpf (pf) in (p)
    end // end of [else]    
end // end of [then]
else (p) // end of [else]
//
end // end of [loop]
//
val p0 = ptrcast(str)
//
in
  $UN.cast{sizeLte(n)}(loop (p0, env) - p0)
end // end of [strnptr_foreach_env]

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

implement
{env}(*tmp*)
strnptr_rforeach$cont (c, env) = true

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

implement
{}(*tmp*)
strnptr_rforeach
  (str) = let
//
var env: void = ()
//
in
  strnptr_rforeach_env<void> (str, env)
end // end of [strnptr_rforeach]

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

implement
{env}(*tmp*)
strnptr_rforeach_env
  {n}(str, env) = let
//
fun loop
(
  p0: ptr, p1: ptr, env: &env >> _
) : ptr = let
in
//
if
(p1 > p0)
then let
  val p2 = ptr_pred<char> (p1)
  val (pf, fpf | p2) =
    $UN.ptr0_vtake{charNZ}(p2)
  val cont =
    strnptr_rforeach$cont<env> (!p2, env)
  // end of [val]
in
  if cont
    then let
      val () =
      strnptr_rforeach$fwork<env> (!p2, env)
      prval ((*void*)) = fpf (pf)
    in
      loop (p0, p2, env)
    end // end of [then]
    else let
      prval ((*void*)) = fpf (pf) in (p1)
    end // end of [else]    
end // end of [then]
else (p1) // end of [else]
//
end // end of [loop]
//
val p0 = ptrcast(str)
val p1 = ptr_add<char> (p0, length(str))
//
in
  $UN.cast{sizeLte(n)}(p1 - loop (p0, p1, env))
end // end of [strnptr_rforeach_env]

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

(* end of [strptr.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/unsafe.atxt
** Time of generation: Fri Aug 18 03:30:00 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: April, 2012 *)

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

staload "prelude/SATS/unsafe.sats"

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

implement
{}(*tmp*)
int2ptr(i) = cast{ptr}(cast{intptr}(i))
implement
{}(*tmp*)
ptr2int(p) = cast{int}(cast{intptr}(p))

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

implement
{a}(*tmp*)
ptr0_get
  (p) = x where {
  val [l:addr]
    p = g1ofg0_ptr(p)
  prval (pf, fpf) = __assert () where {
    extern praxi __assert (): (a @ l, a? @ l -<lin,prf> void)
  } // end of [prval]
  val x = !p
  prval () = fpf (pf)
} // end of [ptr0_get]

implement{a} ptr1_get = ptr0_get<a>

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

implement
{a}(*tmp*)
ptr0_set
  (p, x) = () where {
  val [l:addr]
    p = g1ofg0_ptr(p)
  prval (pf, fpf) = __assert () where {
    extern praxi __assert (): (a? @ l, a @ l -<lin,prf> void)
  } // end of [prval]
  val () = !p := x
  prval () = fpf (pf)
} // end of [ptr0_set]

implement{a} ptr1_set = ptr0_set<a>

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

implement
{a}(*tmp*)
ptr0_exch
  (p, x) = () where {
  val p = g1ofg0_ptr(p)
  val (pf, fpf | p) = ptr_vtake{a}(p)
  val tmp = !p
  val ( ) = !p := x
  val ( ) = x := tmp
  prval () = fpf (pf)
} // end of [ptr0_exch]

implement{a} ptr1_exch = ptr0_exch<a>

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

implement
{a}(*tmp*)
ptr0_intch
  (p1, p2) = () where {
  val p1 = g1ofg0_ptr(p1)
  val p2 = g1ofg0_ptr(p2)
  val (pf1, fpf1 | p1) = ptr_vtake{a}(p1)
  val (pf2, fpf2 | p2) = ptr_vtake{a}(p2)
  val tmp = !p1
  val ( ) = !p1 := !p2
  val ( ) = !p2 := tmp
  prval () = fpf1 (pf1)
  prval () = fpf2 (pf2)
} (* end of [ptr0_intch] *)

implement{a} ptr1_intch = ptr0_intch<a>

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

implement
{a}(*tmp*)
ptr0_getinc(p0) = let
  val p = p0
  val x = ptr0_get<a>(p)
  val () = p0 := ptr_succ<a>(p) in (x)
end // end of [ptr0_getinc]
implement
{a}(*tmp*)
ptr1_getinc(p0) = let
  val p = p0
  val x = ptr0_get<a>(p)
  val () = p0 := ptr_succ<a>(p) in (x)
end // end of [ptr1_getinc]

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

implement
{a}(*tmp*)
ptr0_setinc(p0, x) = let
  val p = p0
  val () = ptr0_set<a>(p, x)
  val () = p0 := ptr_succ<a>(p) in (*void*)
end // end of [ptr0_setinc]
implement
{a}(*tmp*)
ptr1_setinc(p0, x) = let
  val p = p0
  val () = ptr0_set<a>(p, x)
  val () = p0 := ptr_succ<a>(p) in (*void*)
end // end of [ptr1_setinc]

(* ****** ****** *)
//
implement
{a}(*tmp*)
ptr0_get_at_int (p, i) =
  ptr0_get<a> (ptr0_add_gint<a> (p, i))
implement
{a}(*tmp*)
ptr0_set_at_int (p, i, x) =
  ptr0_set<a> (ptr0_add_gint<a> (p, i), x)
//
implement
{a}(*tmp*)
ptr0_get_at_size (p, i) =
  ptr0_get<a> (ptr0_add_guint<a> (p, i))
implement
{a}(*tmp*)
ptr0_set_at_size (p, i, x) =
  ptr0_set<a> (ptr0_add_guint<a> (p, i), x)
//
(* ****** ****** *)

implement{a}
cptr_get (p) = ptr1_get<a> (cptr2ptr(p))

implement{a}
cptr_set (p, x) = ptr1_set<a> (cptr2ptr(p), x)

implement{a}
cptr_exch (p, x) = ptr1_exch<a> (cptr2ptr(p), x)

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

implement{a}
ptr0_addby (p, x) = let
  val x0 = ptr0_get<a> (p) in ptr0_set<a> (p, gadd_val_val<a> (x0, x))
end // end of [ptr0_addby]
implement{a} ptr1_addby = ptr0_addby<a>

implement{a}
ptr0_subby (p, x) = let
  val x0 = ptr0_get<a> (p) in ptr0_set<a> (p, gsub_val_val<a> (x0, x))
end // end of [ptr0_subby]
implement{a} ptr1_subby = ptr0_subby<a>

implement{a}
ptr0_mulby (p, x) = let
  val x0 = ptr0_get<a> (p) in ptr0_set<a> (p, gmul_val_val<a> (x0, x))
end // end of [ptr0_mulby]
implement{a} ptr1_mulby = ptr0_mulby<a>

implement{a}
ptr0_divby (p, x) = let
  val x0 = ptr0_get<a> (p) in ptr0_set<a> (p, gdiv_val_val<a> (x0, x))
end // end of [ptr0_divby]
implement{a} ptr1_divby = ptr0_divby<a>

implement{a}
ptr0_modby (p, x) = let
  val x0 = ptr0_get<a> (p) in ptr0_set<a> (p, gmod_val_val<a> (x0, x))
end // end of [ptr0_modby]
implement{a} ptr1_modby = ptr0_modby<a>

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

implement{a}
ptr1_list_next
  (p) = p_next where
{
  val xs =
  castvwtp1{list_vt(a,1)}(p)
  val+@list_vt_cons(_, xs_next) = xs
  val p_next = addr@(xs_next)
  prval ((*void*)) = fold@ (xs)
  prval ((*void*)) = cast2void (xs)
} (* end of [ptr1_list_next] *)

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

(* end of [unsafe.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/checkast.atxt
** Time of generation: Fri Aug 18 03:30:00 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: gmhwxiATgmailDOTcom *)
(* Start time: December, 2013 *)

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

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

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

(*
staload "prelude/SATS/checkast.sats"
*)

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

implement
{}(*tmp*)
checkast_charNZ
  (x, errmsg) = let
//
#define CNUL '\000'
//
val x = g1ofg0_char(x)
//
in
//
if
(
x != CNUL
)
then (x)
else let
  val () =
    fprint! (stderr_ref, "exit(ATS): ", errmsg) in exit(1)
  // end of [val]
end // end of [else]
//
end // end of [checkast_charNZ]

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

implement{tk}
checkast_gintLt
  (x, i, errmsg) = let
  val x = g1ofg0_int(x)
in
//
if x < i
  then (x)
  else let
    val () =
      fprint! (stderr_ref, "exit(ATS): ", errmsg) in exit(1)
    // end of [val]
  end // end of [else]
//
end // end of [checkast_gintLt]

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

implement{tk}
checkast_gintLte
  (x, i, errmsg) = let
  val x = g1ofg0_int(x)
in
//
if x <= i
  then (x)
  else let
    val () =
      fprint! (stderr_ref, "exit(ATS): ", errmsg) in exit(1)
    // end of [val]
  end // end of [else]
//
end // end of [checkast_gintLte]

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

implement{tk}
checkast_gintGt
  (x, i, errmsg) = let
  val x = g1ofg0_int(x)
in
//
if x > i
  then (x)
  else let
    val () =
      fprint! (stderr_ref, "exit(ATS): ", errmsg) in exit(1)
    // end of [val]
  end // end of [else]
//
end // end of [checkast_gintGt]

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

implement{tk}
checkast_gintGte
  (x, i, errmsg) = let
  val x = g1ofg0_int(x)
in
//
if x >= i
  then (x)
  else let
    val () =
      fprint! (stderr_ref, "exit(ATS): ", errmsg) in exit(1)
    // end of [val]
  end // end of [else]
//
end // end of [checkast_gintGte]

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

implement{tk}
checkast_gintBtw
  (x, i, j, errmsg) = let
  val x = g1ofg0_int(x)
in
//
if x >= i
  then
    if x < j then (x)
    else let
      val () =
      fprint! (stderr_ref, "exit(ATS): ", errmsg) in exit(1)
      // end of [val]
    end // end of [else]
  else let
    val () =
      fprint! (stderr_ref, "exit(ATS): ", errmsg) in exit(1)
    // end of [val]
  end // end of [else]
//
end // end of [checkast_gintBtw]

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

implement{tk}
checkast_gintBtwe
  (x, i, j, errmsg) = let
  val x = g1ofg0_int(x)
in
//
if x >= i
  then
    if x <= j then (x)
    else let
      val () =
      fprint! (stderr_ref, "exit(ATS): ", errmsg) in exit(1)
      // end of [val]
    end // end of [else]
  else let
    val () =
      fprint! (stderr_ref, "exit(ATS): ", errmsg) in exit(1)
    // end of [val]
  end // end of [else]
//
end // end of [checkast_gintBtwe]

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

implement{}
checkast_Ptr1
  (x, errmsg) = let
  val x = g1ofg0_ptr(x)
in
//
if x > 0
  then (x)
  else let
    val () =
      fprint! (stderr_ref, "exit(ATS): ", errmsg) in exit(1)
    // end of [val]
  end // end of [else]
// end of [if]
//
end // end of [checkast_Ptr1]

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

implement{}
checkast_Strptr1
  (x, errmsg) = let
  val p = strptr2ptr(x)
in
//
if p > 0
  then (x)
  else let
    prval () =
      strptr_free_null (x)
    val ((*void*)) =
      fprint! (stderr_ref, "exit(ATS): ", errmsg)
    val ((*void*)) = exit_void(1)
  in
    $UN.castvwtp0{Strptr1}(0)
  end // end of [else]
// end of [if]
//
end // end of [checkast_Strptr1]

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

(* end of [checkast.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/tuple.atxt
** Time of generation: Fri Aug 18 03:30:00 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: December, 2012 *)

(* ****** ****** *)
//
implement
fprint_tup$beg<>
  (out) = fprint_string(out, "(")
implement
fprint_tup$end<>
  (out) = fprint_string(out, ")")
implement
fprint_tup$sep<>
  (out) = fprint_string(out, ", ")
//
(* ****** ****** *)
//
implement
{a0,a1}
fprint_tupval2
  (out, x) = let
  val () = fprint_tup$beg<> (out)
  val () = fprint_val<a0> (out, x.0)
  val () = fprint_tup$sep<> (out)
  val () = fprint_val<a1> (out, x.1)
  val () = fprint_tup$end<> (out)
in
  // nothing
end // end of [fprint_tupval2]
//
implement
(a0,a1)
fprint_val<tup(a0,a1)>
  (out, x) = fprint_tupval2<a0,a1> (out, x)
//
(* ****** ****** *)
//
implement
{a0,a1,a2}
fprint_tupval3
  (out, x) = let
  val () = fprint_tup$beg<> (out)
  val () = fprint_val<a0> (out, x.0)
  val () = fprint_tup$sep<> (out)
  val () = fprint_val<a1> (out, x.1)
  val () = fprint_tup$sep<> (out)
  val () = fprint_val<a2> (out, x.2)
  val () = fprint_tup$end<> (out)
in
  // nothing
end // end of [fprint_tupval3]
//
implement
(a0,a1,a2)
fprint_val<tup(a0,a1,a2)>
  (out, x) = fprint_tupval3<a0,a1,a2> (out, x)
//
(* ****** ****** *)
//
implement
{a0,a1,a2,a3}
fprint_tupval4
  (out, x) = let
  val () = fprint_tup$beg<> (out)
  val () = fprint_val<a0> (out, x.0)
  val () = fprint_tup$sep<> (out)
  val () = fprint_val<a1> (out, x.1)
  val () = fprint_tup$sep<> (out)
  val () = fprint_val<a2> (out, x.2)
  val () = fprint_tup$sep<> (out)
  val () = fprint_val<a3> (out, x.3)
  val () = fprint_tup$end<> (out)
in
  // nothing
end // end of [fprint_tupval4]
//
implement
(a0,a1,a2,a3)
fprint_val<tup(a0,a1,a2,a3)>
  (out, x) = fprint_tupval4<a0,a1,a2,a3> (out, x)
//
(* ****** ****** *)
//
implement
{a0,a1}
fprint_tupref2
  (out, x) = let
  val () = fprint_tup$beg<> (out)
  val () = fprint_ref<a0> (out, x.0)
  val () = fprint_tup$sep<> (out)
  val () = fprint_ref<a1> (out, x.1)
  val () = fprint_tup$end<> (out)
in
  // nothing
end // end of [fprint_tupref2]
//
implement
(a0,a1)
fprint_ref<tup(a0,a1)>
  (out, x) = fprint_tupref2<a0,a1> (out, x)
//
(* ****** ****** *)
//
implement
{a0,a1,a2}
fprint_tupref3
  (out, x) = let
  val () = fprint_tup$beg<> (out)
  val () = fprint_ref<a0> (out, x.0)
  val () = fprint_tup$sep<> (out)
  val () = fprint_ref<a1> (out, x.1)
  val () = fprint_tup$sep<> (out)
  val () = fprint_ref<a2> (out, x.2)
  val () = fprint_tup$end<> (out)
in
  // nothing
end // end of [fprint_tupref3]

implement
(a0,a1,a2)
fprint_ref<tup(a0,a1,a2)>
  (out, x) = fprint_tupref3<a0,a1,a2> (out, x)
//
(* ****** ****** *)
//
implement
{a0,a1,a2,a3}
fprint_tupref4
  (out, x) = let
  val () = fprint_tup$beg<> (out)
  val () = fprint_ref<a0> (out, x.0)
  val () = fprint_tup$sep<> (out)
  val () = fprint_ref<a1> (out, x.1)
  val () = fprint_tup$sep<> (out)
  val () = fprint_ref<a2> (out, x.2)
  val () = fprint_tup$sep<> (out)
  val () = fprint_ref<a3> (out, x.3)
  val () = fprint_tup$end<> (out)
in
  // nothing
end // end of [fprint_tupref4]
//
implement
(a0,a1,a2,a3)
fprint_ref<tup(a0,a1,a2,a3)>
  (out, x) = fprint_tupref4<a0,a1,a2,a3> (out, x)
//
(* ****** ****** *)
//
implement
fprint_tupbox$beg<>
  (out) = fprint_string(out, "$tup(")
//
implement
fprint_tupbox$end<> (out) = fprint_string(out, ")")
implement
fprint_tupbox$sep<> (out) = fprint_string(out, ", ")
//
(* ****** ****** *)
//
implement
{a0}
fprint_tupbox1
  (out, x) = let
  val () = fprint_tupbox$beg<> (out)
  val () = fprint_val<a0> (out, x.0)
  val () = fprint_tupbox$end<> (out)
in
  // nothing
end // end of [fprint_tupbox1]
//
implement(a0)
fprint_val<tupbox(a0)>
  (out, x) = fprint_tupbox1<a0> (out, x)
//
(* ****** ****** *)
//
implement
{a0,a1}
fprint_tupbox2
  (out, x) = let
  val () = fprint_tupbox$beg<> (out)
  val () = fprint_val<a0> (out, x.0)
  val () = fprint_tupbox$sep<> (out)
  val () = fprint_val<a1> (out, x.1)
  val () = fprint_tupbox$end<> (out)
in
  // nothing
end // end of [fprint_tupbox2]
//
implement(a0,a1)
fprint_val<tupbox(a0,a1)>
  (out, x) = fprint_tupbox2<a0,a1> (out, x)
//
(* ****** ****** *)
//
implement
{a0,a1,a2}
fprint_tupbox3
  (out, x) = let
  val () = fprint_tupbox$beg<> (out)
  val () = fprint_val<a0> (out, x.0)
  val () = fprint_tupbox$sep<> (out)
  val () = fprint_val<a1> (out, x.1)
  val () = fprint_tupbox$sep<> (out)
  val () = fprint_val<a2> (out, x.2)
  val () = fprint_tupbox$end<> (out)
in
  // nothing
end // end of [fprint_tupbox3]
//
implement(a0,a1,a2)
fprint_val<tupbox(a0,a1,a2)>
  (out, x) = fprint_tupbox3<a0,a1,a2> (out, x)
//
(* ****** ****** *)
//
implement
{a0,a1,a2,a3}
fprint_tupbox4
  (out, x) = let
  val () = fprint_tupbox$beg<> (out)
  val () = fprint_val<a0> (out, x.0)
  val () = fprint_tupbox$sep<> (out)
  val () = fprint_val<a1> (out, x.1)
  val () = fprint_tupbox$sep<> (out)
  val () = fprint_val<a2> (out, x.2)
  val () = fprint_tupbox$sep<> (out)
  val () = fprint_val<a3> (out, x.3)
  val () = fprint_tupbox$end<> (out)
in
  // nothing
end // end of [fprint_tupbox4]
//
implement(a0,a1,a2,a3)
fprint_val<tupbox(a0,a1,a2,a3)>
  (out, x) = fprint_tupbox4<a0,a1,a2,a3> (out, x)
//
(* ****** ****** *)

implement
{a0,a1}
tupval2_equal(x, y) =
(
//
if
gequal_val_val<a0>(x.0, y.0)
then gequal_val_val<a1>(x.1, y.1) else false
//
) (* end of [tupval2_val_val] *)

implement
(a0,a1)
gequal_val_val<tup(a0,a1)> (x, y) = tupval2_equal<a0,a1> (x, y)

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

implement
{a0,a1,a2}
tupval3_equal(x, y) =
(
//
if
gequal_val_val<a0>(x.0, y.0)
then
(
  if gequal_val_val<a1>(x.1, y.1)
    then gequal_val_val<a2>(x.2, y.2) else false
  // end of [if]
) else false
//
) (* end of [tupval3_val_val] *)

implement
(a0,a1,a2)
gequal_val_val<tup(a0,a1,a2)> (x, y) = tupval3_equal<a0,a1,a2> (x, y)

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

implement
{a0,a1,a2,a3}
tupval4_equal(x, y) =
(
//
if
gequal_val_val<a0>(x.0, y.0)
then
(
if
gequal_val_val<a1>(x.1, y.1)
then (
if
gequal_val_val<a2>(x.2, y.2)
  then gequal_val_val<a3>(x.3, y.3) else false
// end of [if]
) else false
) else false
//
) (* end of [tupval4_val_val] *)

implement
(a0,a1,a2,a3)
gequal_val_val<tup(a0,a1,a2,a3)> (x, y) = tupval4_equal<a0,a1,a2,a3> (x, y)

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

implement
{a0,a1}
tupval2_compare (x, y) = let
  val sgn0 = gcompare_val_val<a0> (x.0, y.0)
in
  if sgn0 != 0
    then sgn0 else gcompare_val_val<a1> (x.1, y.1)
  // end of [if]
end // end of [tupval2_compare]  

implement
(a0,a1)
gcompare_val_val<tup(a0,a1)> (x, y) = tupval2_compare<a0,a1> (x, y)

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

implement
{a0,a1,a2}
tupval3_compare (x, y) = let
//
val sgn0 = gcompare_val_val<a0> (x.0, y.0)
//
in
//
if
sgn0 != 0
then sgn0
else let
  val sgn1 = gcompare_val_val<a1> (x.1, y.1)
in
  if sgn1 != 0
    then sgn1 else gcompare_val_val<a2> (x.2, y.2)
  // end of [if]
end // end of [if]
//
end // end of [tupval3_compare]

implement
(a0,a1,a2)
gcompare_val_val<tup(a0,a1,a2)> (x, y) = tupval3_compare<a0,a1,a2> (x, y)

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

implement
{a0,a1,a2,a3}
tupval4_compare (x, y) = let
//
val sgn0 = gcompare_val_val<a0> (x.0, y.0)
//
in
//
if
sgn0 != 0
then sgn0
else let
  val sgn1 = gcompare_val_val<a1> (x.1, y.1)
in
//
if sgn1 != 0 then sgn1
else let
  val sgn2 = gcompare_val_val<a2> (x.2, y.2)
in
  if sgn2 != 0
    then sgn2 else gcompare_val_val<a3> (x.3, y.3)
  // end of [if]
end // end of [if]
//
end // end of [if]
//
end // end of [tupval4_compare]  

implement
(a0,a1,a2,a3)
gcompare_val_val<tup(a0,a1,a2,a3)> (x, y) = tupval4_compare<a0,a1,a2,a3> (x, y)

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

(* end of [tuple.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/reference.atxt
** Time of generation: Fri Aug 18 03:30:00 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: May, 2012 *)

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

implement
{a}(*tmp*)
ref = ref_make_elt<a>

implement
{a}(*tmp*)
ref_make_elt
  (x0) = let
//
val
(pfat,pfgc|p) = ptr_alloc<a>()
prval () = mfree_gc_v_elim(pfgc)
//
in
  !p := x0;
  ref_make_viewptr{a}(pfat | p)
end // end of [ref_make_elt]

(* ****** ****** *)
//
implement
{a}(*tmp*)
ref_make_type_elt
  (_type_, x) = ref_make_elt<a>(x)
//
(* ****** ****** *)

implement
{a}(*tmp*)
ref_get_elt
  (r) = !p where {
  val (vbox _ | p) = ref_get_viewptr (r)
} // end of [ref_get_elt]

implement
{a}(*tmp*)
ref_set_elt
  (r, x) = let
  val (vbox _ | p) = ref_get_viewptr (r)
in
  !p := x // assignment
end // end of [ref_set_elt]

implement
{a}(*tmp*)
ref_exch_elt
  (r, x) = let
  val (vbox _ | p) = ref_get_viewptr (r)
in
  !p :=: x // exchanging
end // end of [ref_exch_elt]

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

implement
{}(*tmp*)
ref_app_fun{a} (r, f) = let
  val (vbox _ | p) = ref_get_viewptr (r) in f (!p)
end // end of [ref_app_fun]

implement
{}(*tmp*)
ref_app_funenv{a}
  (pfv | r, f, env) = let
  val (vbox _ | p) = ref_get_viewptr (r) in f (pfv | !p, env)
end // end of [ref_app_funenv]

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

implement
{}(*tmp*)
ref_vtakeout{a} (r) = let
//
val (
  vbox pf | p
) = ref_get_viewptr (r)
//
prval (pf, fpf) = __copy (pf) where
{
  extern praxi __copy {l:addr} (pf: !a @ l): (a @ l, a @ l -<lin,prf> void)
} (* end of [prval] *)
//
in
  (pf, fpf | p)
end // end of [ref_vtakeout]

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

(* end of [reference.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/filebas.atxt
** Time of generation: Fri Aug 18 03:30:00 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: Feburary, 2012 *)

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

#define
ATS_DYNLOADFLAG 0 // no dynloading at run-time

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

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

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

staload
_(*INT*) = "prelude/DATS/integer.dats"

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

staload
STDIO = "libats/libc/SATS/stdio.sats"
vtypedef
FILEptr1 = $STDIO.FILEptr1 (*linear/nonnull*)
//
(* ****** ****** *)
//
staload STAT = "libats/libc/SATS/sys/stat.sats"
//
(* ****** ****** *)

#define c2i char2int0
#define i2c int2char0

(* ****** ****** *)
//
// HX-2013-06:
// this is just Unix convention
//
implement{} dirsep_get () = '/'
implement{} dirname_self () = "."
implement{} dirname_parent () = ".."
//
(* ****** ****** *)

implement
{}(*tmp*)
filename_get_ext (name) = let
//
#define NUL '\000'
overload + with add_ptr_bsz
//
fun loop
(
  p1: ptr, p2: ptr, c0: char
) : ptr = let
  val c = $UN.ptr0_get<char> (p1)
in
  if c != NUL then let
    val p1 = p1 + i2sz(1)
  in
    if c != c0 then loop (p1, p2, c0) else loop (p1, p1, c0)
  end else p2 // end of [if]
end // end of [loop]
//
val p1 = string2ptr(name)
val p2 = $effmask_all (loop (p1, the_null_ptr, '.'))
//
in
  $UN.castvwtp0{vStrptr0}(p2)
end // end of [filename_get_ext]

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

implement
{}(*tmp*)
filename_test_ext
  (name, ext0) = let
//
val (fpf | ext) = filename_get_ext (name)
//
val ans =
(
  if strptr2ptr(ext) > 0
    then eq_string_string (ext0, $UN.strptr2string(ext))
    else false
  // end of [if]
) : bool // end of [val]
//
prval () = fpf (ext)
//
in
  ans
end // end of [filename_test_ext]

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

implement
{}(*tmp*)
filename_get_base (name) = let
//
#define NUL '\000'
overload + with add_ptr_bsz
//
fun loop
(
  p1: ptr, p2: ptr, c0: char
) : ptr = let
  val c = $UN.ptr0_get<char> (p1)
in
  if c != NUL then let
    val p1 = p1 + i2sz(1)
  in
    if c != c0 then loop (p1, p2, c0) else loop (p1, p1, c0)
  end else p2 // end of [if]
end // end of [loop]
//
val c0 = dirsep_get<> ()
val p1 = string2ptr(name)
val p2 = $effmask_all (loop (p1, p1, c0))
//
in
  $UN.castvwtp0{vStrptr1}(p2)
end // end of [filename_get_base]

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

implement
{}(*tmp*)
filename_test_base
  (name, base0) = let
//
val (fpf | base) = filename_get_base (name)
//
val ans = eq_string_string (base0, $UN.strptr2string(base))
//
prval () = fpf (base)
//
in
  ans
end // end of [filename_test_base]

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

(*
//
// HX-2013-04:
// this is now implemented in [filebas.cats].
//
local

extern
castfn file_mode
  {fm:file_mode} (x: string):<> file_mode (fm)
// end of [extern]

in (* in of [local] *)

implement file_mode_r = file_mode ("r")
implement file_mode_rr = file_mode ("r+")
implement file_mode_w = file_mode ("w")
implement file_mode_ww = file_mode ("w+")
implement file_mode_a = file_mode ("a")
implement file_mode_aa = file_mode ("a+")

end // end of [local]
*)

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

extern
castfn
__cast_filp (r: FILEref): FILEptr1

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

implement
{}(*tmp*)
test_file_mode
  (path) = let
//
typedef stat = $STAT.stat
//
var st: stat?
val err = $STAT.stat (path, st)
//
in
//
if err >= 0
then let
  prval () = opt_unsome{stat}(st)
  val test =
  test_file_mode$pred<> ($UN.cast{uint}(st.st_mode))
in
  if test then 1(*true*) else 0(*false*)
end // end of [then]
else let
  prval () = opt_unnone{stat}(st) in ~1(*failure*)
end // end of [else]
//
end // end of [test_file_mode]

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

implement
{}(*tmp*)
fileref_open_opt
  (path, fm) = let
//
val
filp = $STDIO.fopen (path, fm)
val
isnot = $STDIO.FILEptr2ptr(filp) > 0
//
in
//
if
isnot
then let
//
val filr =
  $STDIO.FILEptr_refize(filp)
//
in
  Some_vt{FILEref}(filr) // success
end // end of [then]
else let
//
prval () =
  $STDIO.FILEptr_free_null(filp)
//
in
  None_vt{FILEref}((*void*)) // failure
end // end of [else]
//
end // end of [fileref_open_opt]

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

(*
//
// HX: atspre_fileref_close
//
implement
fileref_close (fil) = $STDIO.fclose0_exn (fil)
*)

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

(*
//
// HX: atspre_fileref_flush
//
implement
fileref_flush (fil) = $STDIO.fflush0_exn (fil)
*)

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

(*
//
// HX: atspre_fileref_getc
//
implement fileref_getc (inp) = $STDIO.fgetc0 (inp)
*)

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

(*
//
// HX: atspre_fileref_putc_int
// HX: atspre_fileref_putc_char
//
implement
fileref_putc_int (out, c) = let
  val _(*ignored*) = $STDIO.fputc0 (c, out) in (*nothing*)
end // end of [fileref_putc_int]
implement
fileref_putc_char (out, c) = fileref_putc_int (out, (c2i)c)
*)

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

(*
//
// HX: atspre_fileref_puts
//
implement
fileref_puts (out, s) = let
  val _(*ignored*) = $STDIO.fputs0 (s, out) in (*nothing*)
end // end of [fileref_puts]
*)

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

(*
//
// HX: atspre_fileref_is_eof
//
implement
fileref_is_eof (fil) =
  if $STDIO.feof0 (fil) != 0 true else false
// end of [fileref_is_eof]
*)

(* ****** ****** *)
//
implement fileref_load<int> = fileref_load_int
implement fileref_load<lint> = fileref_load_lint
implement fileref_load<uint> = fileref_load_uint
implement fileref_load<ulint> = fileref_load_ulint
//
implement fileref_load<float> = fileref_load_float
implement fileref_load<double> = fileref_load_double
//
(* ****** ****** *)

implement{a}
fileref_get_optval (r) = let
  var x: a?
  val yn = fileref_load<a> (r, x)
in
  option_vt_make_opt<a> (yn, x)
end // end of [fileref_get_optval]

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

implement{a}
fileref_get_exnmsg
  (r, msg) = let
  var x: a?
  val yn = fileref_load<a> (r, x)
in
  if yn then let
    prval () = opt_unsome (x) in x
  end else let
    prval () = opt_unnone (x) in exit_errmsg (1, msg)
  end (* end of [if] *)
end // end of [fileref_get_exnmsg]

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

implement
fileref_get_line_charlst
  (inp) = let
//
val EOL = '\n'
//
fun loop
(
  inp: FILEref, res: &ptr? >> charlst_vt
) : void = let
  val i = fileref_getc (inp)
in
//
if i >= 0 then let
  val c = int2char0(i)
in
//
if (c != EOL) then let
  val () =
  (
    res :=
    list_vt_cons{char}{0}(c, _)
  )
  val+list_vt_cons (_, res1) = res
  val () = loop (inp, res1)
  prval () = fold@ (res)
in
  // nothing
end else (res := list_vt_nil)
//
end else (res := list_vt_nil)
//
end // end of [loop]
//
var res: ptr
val () = loop (inp, res)
//
in
  res
end // end of [fileref_get_line_charlst]

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

implement
fileref_get_lines_charlstlst
  (inp) = let
//
vtypedef line = charlst_vt
vtypedef lines = List0_vt (line)
//
fun loop
(
  inp: FILEref
, res: &lines? >> lines
) : void = let
  val iseof = fileref_is_eof (inp)
in
//
if iseof then let
  val () = (res := list_vt_nil ())
in
  // nothing
end else let
  val line =
    fileref_get_line_charlst (inp)
  val () =
  (
    res := list_vt_cons{line}{0}(line, _)
  )
  val+list_vt_cons (_, res1) = res
  val () = loop (inp, res1)
  prval () = fold@ (res)
in
  // nothing
end // end of [if]
//
end // end of [loop]
//
var res: lines
val () = loop (inp, res)
//
in
  res
end // end of [fileref_get_lines_charlstlst]

(* ****** ****** *)
//
implement
fileref_get_file_charlst
  (inp) = fileref_get2_file_charlst (inp, ~1)
//
(* ****** ****** *)

local

fun loop
(
  inp: FILEref
, n: int, res: &ptr? >> charlst_vt
) : int = let
in
//
if n != 0 then let
  val i = fileref_getc (inp)
in
  if i >= 0 then let
    val () =
    (
      res :=
      list_vt_cons{char}{0}(i2c(i), _)
    )
    val+list_vt_cons (_, res1) = res
    val n = loop (inp, pred(n), res1)
    prval () = fold@ (res)
  in
    n
  end else let
    val () = res := list_vt_nil () in (n)
  end // end of [if]
end else let
  val () = res := list_vt_nil () in n(*=0*)
end // end of [if]
//
end // end of [loop]

in (* in of [local] *)

implement
fileref_get2_file_charlst
  (inp, n) = res where
{
  var res: ptr; val _(*nleft*) = loop (inp, n, res)
} // end of [fileref_nget_file_charlst]

end // end of [local]

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

implement
fileref_put_charlst
  (out, cs) = let
//
fun loop
(
  out: FILEref, cs: List(char)
) : void = let
in
//
case+ cs of
| list_cons (c, cs) => let
    val () = fileref_putc (out, c) in loop (out, cs)
  end // end of [list_cons]
| list_nil ((*void*)) => ()
//
end // end of [loop]
//
in
  loop (out, cs)
end // end of [fileref_put_charlst]

(* ****** ****** *)
//
implement
{}(*tmp*)
fileref_get_line_string$bufsize () = 64
implement
{}(*tmp*)
fileref_get_file_string$bufsize () = 1024
//
(* ****** ****** *)

implement
{}(*tmp*)
fileref_get_line_string
  (inp) = let
//
var nlen: int // uninitialized
val line = fileref_get_line_string_main (inp, nlen)
prval () = lemma_strnptr_param (line)
//
in
  strnptr2strptr (line)
end // end of [fileref_get_line_string]

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

implement
{}(*tmp*)
fileref_get_line_string_main
  (inp, nlen) = let
//
val bsz =
fileref_get_line_string$bufsize ()
//
val [l:addr,n:int] str = $extfcall
( Strnptr0
, "atspre_fileref_get_line_string_main2", bsz, inp, addr@(nlen)
)
//
prval () = lemma_strnptr_param (str)
//
extern
praxi
__assert {l:addr} (pf: !int? @ l >> int (n) @ l): void
prval () = __assert (view@(nlen)) 
//
val isnot = strnptr_isnot_null (str)
//
in
//
if isnot then str else let
  val (
  ) = exit_errmsg_void (1, "[fileref_get_line_string] failed.")
  val () = assert (nlen >= 0) // HX: for TC // deadcode at run-time
in
  str // HX: [str]=null is not returned
end (* end of [if] *)
//
end // end of [fileref_get_line_string_main]

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

implement
{}(*tmp*)
fileref_get_lines_stringlst
  (inp) = let
//
vtypedef line = Strptr1
vtypedef lines = List0_vt (line)
//
fun loop
(
  inp: FILEref
, res: &lines? >> lines
) : void = let
  val iseof = fileref_is_eof (inp)
in
//
if iseof then let
  val () = (res := list_vt_nil ())
in
  // nothing
end else let
  val line =
    fileref_get_line_string (inp)
  val () =
  (
    res := list_vt_cons{line}{0}(line, _)
  )
  val+list_vt_cons (_, res1) = res
  val () = loop (inp, res1)
  prval () = fold@ (res)
in
  // nothing
end // end of [if]
//
end // end of [loop]
//
var res: lines
val () = loop (inp, res)
//
in
  res
end // end of [fileref_get_lines_stringlst]

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

implement
{}(*tmp*)
fileref_get_file_string
  (inp) = let
//
fun loop
(
  inp: FILEref
, p0: ptr, n0: size_t
, p1: ptr, n1: size_t
) : Strptr1 = let
//
#define CNUL '\000'
//
val nw =
$extfcall(size_t, "atslib_libats_libc_fread", p1, 1, n1, inp)
//
in (* in-of-let *)
//
if
(nw > 0)
then let
  val n1 = n1 - nw
  val p1 = add_ptr_bsz (p1, nw)
in
  if n1 > 0 then
    loop (inp, p0, n0, p1, n1) else loop2 (inp, p0, n0)
  // end of [if]
end // end of [then]
else let
  val () = $UN.ptr0_set<char> (p1, CNUL) in $UN.castvwtp0{Strptr1}(p0)
end // end of [else]
//
end // end of [loop]
//
and loop2
(
  inp: FILEref, p0: ptr, n0: size_t
) : Strptr1 = let
  val bsz = succ(n0)
  val bsz2 = g1ofg0(bsz + bsz)
  val (pf, pfgc | p0_) = malloc_gc (bsz2)
  val p0_ = $UN.castvwtp0{ptr}((pf, pfgc | p0_))
//
  val _(*ptr*) =
  $extfcall(ptr, "atslib_libats_libc_memcpy", p0_, p0, n0)
//
  val () = strptr_free ($UN.castvwtp0{Strptr1}(p0))
  val n0_ = pred(g0ofg1(bsz2))
  val p1_ = add_ptr_bsz (p0_, n0)
in
  loop (inp, p0_, n0_, p1_, bsz)
end // end of [loop2]
//
val bsz =
  fileref_get_file_string$bufsize ()
val bsz = i2sz(bsz)
val (pf, pfgc | p0_) = malloc_gc (bsz)
val p0_ = $UN.castvwtp0{ptr}((pf, pfgc | p0_))
val n0_ = pred(bsz)
//
in
  loop (inp, p0_, n0_, p0_, n0_)
end // end of [fileref_get_file_string]

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

%{
extern
atstype_ptr
atspre_fileref_get_line_string_main2
(
  atstype_int bsz0
, atstype_ptr filp0
, atstype_ref nlen // int *nlen
)
{
//
  int bsz = bsz0 ;
  FILE *filp = (FILE*)filp0 ;
  int ofs = 0, ofs2 ;
  char *buf, *buf2, *pres ;
  buf = atspre_malloc_gc(bsz) ;
//
  while (1) {
    buf2 = buf+ofs ;
    pres = fgets(buf2, bsz-ofs, filp) ;
    if (!pres)
    {
      if (feof(filp))
      {
        *buf2 = '\000' ;
        *(int*)nlen = ofs ; return buf ;
      } else {
        atspre_mfree_gc(buf) ;
        *(int*)nlen = -1 ; return (char*)0 ;
      } // end of [if]
    }
    ofs2 = strlen(buf2) ;
    if (ofs2==0) return buf ;
    ofs += ofs2 ; // HX: ofs > 0
//
// HX: the newline symbol needs to be trimmed:
//
    if (buf[ofs-1]=='\n')
    {
      buf[ofs-1] = '\0'; *(int*)nlen = ofs-1 ; return buf ;
    }
//
// HX: there is room // so there are no more chars:
//
    if (ofs+1 < bsz) { *(int*)nlen = ofs ; return buf ; }
//
// HX: there is no room // so another call to [fgets] is needed:
//
    bsz *= 2 ;
    buf2 = buf ; buf = atspre_malloc_gc(bsz) ; memcpy(buf, buf2, ofs) ;
    atspre_mfree_gc(buf2) ;
  } // end of [while]
//
  return buf ; // HX: deadcode
//
} // end of [atspre_fileref_get_line_string_main2]
%}

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

implement
{}(*tmp*)
fileref_get_word (inp) = let
//
vtypedef
res = List0_vt(charNZ)
//
fun
loop1
(
// argless
) : res = let
//
val c = $STDIO.fgetc0(inp)
//
in
//
if
(c > 0)
then let
  val c =
    $UN.cast{charNZ}(c)
  val test =
    fileref_get_word$isalpha<>(c)
  // end of [val]
in
  if test
    then loop2(c, list_vt_nil()) else loop1()
end // end of [then]
else list_vt_nil ((*void*))
//
end // end of [loop1]

and
loop2
(
  c: charNZ, cs: res
) : res = let
//
val c2 =
  $STDIO.fgetc0(inp)
val cs =
  list_vt_cons{charNZ}(c, cs)
//
in
//
if
(c2 > 0)
then let
//
val c2 =
  $UN.cast{charNZ}(c2)
val test =
  fileref_get_word$isalpha<>(c2)
//
in
  if test then loop2(c2, cs) else cs
end // end of [then]
else (cs) // end of [else]
//
end // end of [loop2]
//
val cs = loop1((*void*))
//
in
  case+ cs of
  | list_vt_cons _ => let
      val str =
        string_make_rlist
          ($UN.list_vt2t(cs))
        // string_make_rlist
      val () =
        list_vt_free<char>(cs)
      // end of [val]
    in
      strnptr2strptr(str)
    end // end of [list_vt_cons]
  | ~list_vt_nil() => strptr_null()
end // end of [fileref_get_word]

(* ****** ****** *)
//
implement
{}(*tmp*)
fileref_get_word$isalpha
  (charNZ) = isalpha(charNZ)
//
(* ****** ****** *)

implement
{}(*tmp*)
fileref_foreach
  (inp) = let
//
  var env: void = ()
//
in
  fileref_foreach_env(inp, env)
end // end of [fileref_foreach]

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

local
//
staload
"libats/libc/SATS/stdio.sats"
//
extern
fun
fread
(
  ptr, size_t, size_t, FILEref
) : Size = "mac#atslib_libats_libc_fread"
//
in (* in of [local] *)

implement
{env}(*tmp*)
fileref_foreach_env
   (inp, env) = let
//
fun loop
  {l:addr}{n:int}
(
  pf: !b0ytes(n) @ l
| inp: FILEref, bufp: ptr(l), bsz: size_t(n), env: &env
) : void = let
//
val bsz2 = fread (bufp, i2sz(1), bsz, inp)
prval [n2:int] EQINT() = g1uint_get_index (bsz2)
//
in
//
if bsz2 > 0 then
{
  val A = $UN.cast{arrayref(char,n2)}(bufp)
  val () = fileref_foreach$fworkv<env> (A, bsz2, env)
  val ((*void*)) = loop (pf | inp, bufp, bsz, env)
} (* end of [if] *)
//
end // end of [loop]
//
val bsz = fileref_foreach$bufsize<> ()
val (pf1, pf2 | bufp) = memory$alloc<> (bsz)
val ((*void*)) = loop (pf1 | inp, bufp, bsz, env)
val ((*void*)) = memory$free<> (pf1, pf2 | bufp)
//
in
  // nothing
end // end of [fileref_foreach_env]

end // end of [local]

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

implement
{}(*tmp*)
fileref_foreach$bufsize() = i2sz(4*1024)

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

implement
{env}(*tmp*)
fileref_foreach$fworkv
  (A, n, env) = let
//
implement
{a}{env}
array_foreach$cont(x, env) = true
implement
array_foreach$fwork<char><env>
  (x, env) = fileref_foreach$fwork<env> (x, env)
//
in
  ignoret(arrayref_foreach_env<char><env> (A, n, env))
end // end of [fileref_foreach$fworkv]

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

implement
{}(*tmp*)
streamize_fileref_char
  (inp) = auxmain(inp) where
{
//
typedef elt = char
//
fun
auxmain
(
  inp
: FILEref
) : stream_vt(elt)= $ldelay
(
//
let
  val c0 = fileref_getc(inp)
in
  if c0 >= 0
    then (
      stream_vt_cons(int2char0(c0), auxmain(inp))
    ) else (
(*
      fileref_close(inp); // HX: FILEref is not freed!
*)
      stream_vt_nil((*void*))
    ) (* else *)
  // end of [[if]
end : stream_vt_con(elt)
//
(*
,
//
fileref_close(inp) // HX-2016-09-12: FILEref is not freed!
//
*)
) (* end of [auxmain] *)
//
} (* end of [streamize_fileref_char] *)

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

implement
{}(*tmp*)
streamize_fileref_line
  (inp) = auxmain(inp) where
{
//
vtypedef elt = Strptr1
//
fun
auxmain
(
  inp
: FILEref
) : stream_vt(elt)= $ldelay
(
//
let
  val iseof = fileref_is_eof(inp)
in
  if iseof
    then let
(*
      val () =
        fileref_close(inp) // HX: FILEref is not freed!
      // end of [val]
*)
    in
      stream_vt_nil((*void*))
    end // end of [then]
    else let
      val line =
        fileref_get_line_string(inp)
      // end of [val]
    in
      stream_vt_cons(line, auxmain(inp))
    end // end of [else]
end : stream_vt_con(elt)
//
(*
,
//
fileref_close(inp) // HX-2016-09-12: FILEref is not freed!
//
*)
) (* end of [auxmain] *)
//
} (* end of [streamize_fileref_line] *)

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

implement
{}(*tmp*)
streamize_fileptr_line
  (inp) = auxmain(inp) where
{
//
vtypedef elt = Strptr1
//
fun
auxmain
(
  inp
: FILEref
) : stream_vt(elt)= $ldelay
(
//
let
  val iseof = fileref_is_eof(inp)
in
  if iseof
    then let
      val () =
        fileref_close(inp) // HX: FILEref is not freed!
      // end of [val]
    in
      stream_vt_nil((*void*))
    end // end of [then]
    else let
      val line =
        fileref_get_line_string(inp)
      // end of [val]
    in
      stream_vt_cons(line, auxmain(inp))
    end // end of [else]
end : stream_vt_con(elt)
//
,
//
fileref_close(inp) // HX-2016-09-12: FILEref is not freed!
//
) (* end of [auxmain] *)
//
val inp = $UN.castvwtp0{FILEref}(inp)
//
} (* end of [streamize_fileref_line] *)

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

(* end of [filebas.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/intrange.atxt
** Time of generation: Fri Aug 18 03:30:01 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: June, 2012 *)

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

implement{}
intrange_foreach
  (l, r) = let
  var env: void = ()
in
  intrange_foreach_env<void> (l, r, env)
end // end of [intrange_foreach]

implement{tenv}
intrange_foreach_env
  (l, r, env) = let
//
fun loop
(
  l: int, r: int, env: &tenv
) : int =
(
//
if
l < r
then let
  val cont = intrange_foreach$cont<tenv> (l, env)
in
//
if
cont
then (
  intrange_foreach$fwork<tenv> (l, env); loop (succ(l), r, env)
) else l // end of [if]
//
end // end of [then]
else l // end of [else]
//
) // end of [loop]
//
in
  loop (l, r, env)
end // end of [intrange_foreach_env]

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

implement{env}
intrange_foreach$cont (i, env) = true
(*
implement{env}
intrange_foreach$fwork (i, env) = ((*void*))
*)

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

implement
{}(*tmp*)
int_foreach_cloref
  (n, fwork) = (
//
intrange_foreach_cloref<> (0, n, fwork)
//
) (* end of [int_foreach_cloref] *)

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

implement
{}(*tmp*)
intrange_foreach_cloref
  (l, r, fwork) = let
//
implement
(env)(*tmp*)
intrange_foreach$cont<env> (i, env) = true
implement
(env)(*tmp*)
intrange_foreach$fwork<env>(i, env) = fwork(i)
//
var env: void = ()
//
in
  intrange_foreach_env<void> (l, r, env)
end // end of [intrange_foreach_cloref]

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

implement{}
intrange_rforeach
  (l, r) = let
  var env: void = ()
in
  intrange_rforeach_env<void> (l, r, env)
end // end of [intrange_rforeach]

implement{tenv}
intrange_rforeach_env
  (l, r, env) = let
//
fun loop
(
  l: int, r: int, env: &tenv
) : int =
(
//
if
l < r
then let
  val r1 = pred (r)
  val cont = intrange_rforeach$cont<tenv> (r1, env)
in
//
if
cont
then (
  intrange_rforeach$fwork<tenv> (r1, env); loop (l, r1, env)
) else r // end of [if]
//
end // end of [then]
else r // end of [else]
//
) // end of [loop]
//
in
  loop (l, r, env)
end // end of [intrange_rforeach_env]

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

implement{env}
intrange_rforeach$cont (i, env) = true
(*
implement{env}
intrange_rforeach$fwork (i, env) = ((*void*))
*)

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

implement
{}(*tmp*)
int_rforeach_cloref
  (n, fwork) = (
//
intrange_rforeach_cloref<> (0, n, fwork)
//
) (* end of [int_rforeach_cloref] *)

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

implement
{}(*tmp*)
intrange_rforeach_cloref
  (l, r, fwork) = let
//
implement
(env)(*tmp*)
intrange_rforeach$cont<env> (i, env) = true
implement
(env)(*tmp*)
intrange_rforeach$fwork<env>(i, env) = fwork(i)
//
var env: void = ()
//
in
  intrange_rforeach_env<void> (l, r, env)
end // end of [intrange_rforeach_cloref]

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

implement{}
intrange2_foreach
  (l1, r1, l2, r2) = let
  var env: void = () in
  intrange2_foreach_env<void> (l1, r1, l2, r2, env)
end // end of [intrange2_foreach]

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

implement{tenv}
intrange2_foreach_env
  (l1, r1, l2, r2, env) = let
//
fnx
loop1
(
  i: int, env: &(tenv) >> _
) : void =
(
if i < r1 then loop2 (i, l2, env) else ()
)
//
and
loop2
(
  i: int, j: int, env: &(tenv) >> _
) : void =
(
if
j < r2
then (
  intrange2_foreach$fwork(i, j, env); loop2 (i, j+1, env)
) else loop1 (i+1, env)
)
//
in
  loop1 (l1, env)
end // end of [intrange2_foreach]

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

implement
{}(*tmp*)
streamize_intrange_l
  (m) = aux0(m) where
{
//
vtypedef res_vt = stream_vt(int)
//
fun aux0
(
  m: int
) : res_vt = $ldelay(stream_vt_cons(m, aux0(m+1)))
//
} (* end of [streamize_intrange_l] *)

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

implement
{}(*tmp*)
streamize_intrange_lr
  (m, n) = aux0(m) where
{
//
vtypedef res_vt = stream_vt(int)
//
fun aux0
(
  m: int
) : res_vt = $ldelay
(
  if m < n
    then stream_vt_cons(m, aux0(m+1)) else stream_vt_nil()
  // end of [if]
) : stream_vt_con(int) // [aux0]
//
} (* end of [streamize_intrange_lr] *)

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

(* end of [intrange.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(* Author: Hongwei Xi *)
(* Start time: Feburary, 2012 *)
(* Authoremail: gmhwxiATgmailDOTcom *)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/list.atxt
** Time of generation: Wed Oct  4 21:37:16 2017
*)

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

abstype
List0_(a:t@ype+) = List0(a)

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

primplmnt
lemma_list_param(xs) =
(
//
case+ xs of
| list_nil _ => () | list_cons _ => ()
//
) (* lemma_list_param *)

(* ****** ****** *)
//
implement
{x}(*tmp*)
list_make_sing(x) =
  list_vt_cons{x}(x, list_vt_nil)
implement
{x}(*tmp*)
list_make_pair(x1, x2) =
  list_vt_cons{x}(x1, list_vt_cons{x}(x2, list_vt_nil))
//
(* ****** ****** *)

implement
{x}(*tmp*)
list_make_elt
  {n} (n, x) = let
//
fun loop
  {i:nat | i <= n} .<i>.
(
  i: int i, x: x, res: list_vt(x, n-i)
) :<> list_vt(x, n) =
(
  if (i > 0)
    then loop(pred(i), x, list_vt_cons(x, res)) else res
  // end of [if]
) // end of [loop]
//
in
  loop(n, x, list_vt_nil())
end // end of [list_make_elt]

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

implement
{}(*tmp*)
list_make_intrange
  {l0,r} (l0, r) = let
//
typedef elt = intBtw(l0, r)
vtypedef res(l:int) = list_vt(elt, r-l)
//
fun
loop
{
  l:int
| l0 <= l; l <= r
} .<r-l>.
(
  l: int l, r: int r
, res: &ptr? >> res(l)
) :<!wrt> void =
(
//
if
(l < r)
then let
  val () = res :=
    list_vt_cons{elt}{0}(l, _)
  val+list_vt_cons(_, res1) = res
  val () = loop(l+1, r, res1)
  prval ((*folded*)) = fold@(res)
in
  // nothing
end else (res := list_vt_nil())
//
) (* end of [loop] *)
//
var res: ptr
val ((*void*)) = $effmask_wrt(loop(l0, r, res))
//
in
  res
end // end of [list_make_intrange]

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

implement
{a}(*tmp*)
list_make_array
  {n}(A, n0) = let
//
prval() = lemma_array_param(A)
//
vtypedef res(n:int) = list_vt(a, n)
//
fun
loop
{l:addr}
{n:nat} .<n>.
(
  pf: !array_v(a, l, n) >> array_v(a?!, l, n)
| p0: ptr l
, n0: size_t n
, res: &ptr? >> res(n)
) :<!wrt> void = (
//
if
(n0 > 0)
then let
  prval
  (
    pf1, pf2
  ) = array_v_uncons{a}(pf)
//
  val () = res :=
    list_vt_cons{a}{0}(_, _)
  // end of [val]
  val+list_vt_cons(x, res1) = res
//
  val () = x := !p0
  val p1 = ptr1_succ<a>(p0)
  val () =
    loop(pf2 | p1, pred(n0), res1)
  // end of [val]
  prval () =
    pf := array_v_cons{a?!}(pf1, pf2)
  // end of [prval]
  prval ((*folded*)) = fold@ (res)
in
  // nothing
end // end of [then]
else let
  prval () = array_v_unnil(pf)
  prval () = pf := array_v_nil()
in
  res := list_vt_nil((*void*))
end // end of [else]
//
) (* end of [loop] *)
//
var
res: ptr // uninitialized
//
val ((*void*)) =
  loop(view@(A) | addr@(A), n0, res)
//
in
  res
end // end of [list_make_array]

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

implement
{a}(*tmp*)
list_make_arrpsz
  {n}(ASZ) = let
//
var
asz: size_t
//
val A0 =
arrpsz_get_ptrsize
  (ASZ, asz)
//
val p0 = arrayptr2ptr(A0)
//
prval
pfarr = arrayptr_takeout(A0)
val res = list_make_array(!p0, asz)
prval() = arrayptr_addback(pfarr | A0)
//
in
//
let val () = arrayptr_free(A0) in res end
//
end // end of [list_make_arrpsz]

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

implement
{a}(*tmp*)
print_list(xs) = fprint_list<a>(stdout_ref, xs)
implement
{a}(*tmp*)
prerr_list(xs) = fprint_list<a>(stderr_ref, xs)

(* ****** ****** *)
//
implement
{}(*tmp*)
fprint_list$sep(out) = fprint_string(out, ", ")
// end of [fprint_list$sep]
//
implement
{a}(*tmp*)
fprint_list(out, xs) = let
//
implement(env)
list_iforeach$fwork<a><env>
  (i, x, env) = let
  val () =
  if i > 0
    then fprint_list$sep<(*none*)>(out)
  // end of [if]
  // end of [val]
in
  fprint_val<a>(out, x)
end // end of [list_iforeach$fwork]
//
val _(*len*) = list_iforeach<a>(xs)
//
in
  // nothing
end // end of [fprint_list]
//
implement
{a}(*tmp*)
fprint_list_sep
  (out, xs, sep) = let
//
implement
fprint_list$sep<(*none*)>
  (out) = fprint_string(out, sep)
//
in
  fprint_list<a>(out, xs)
end // end of [fprint_list_sep]
//
(* ****** ****** *)
(*
//
// HX-2012-05:
// Compiling this can be a great challenge!
//
*)
implement
{a}(*tmp*)
fprint_listlist_sep
  (out, xss, sep1, sep2) = let
//
implement
fprint_val<List0_(a)>
  (out, xs) = let
  val xs = $UN.cast{List0(a)}(xs)
in
  fprint_list_sep<a>(out, xs, sep2)
end // end of [fprint_val]
//
in
//
fprint_list_sep<List0_(a)>
  (out, $UN.cast{List(List0_(a))}(xss), sep1)
//
end // end of [fprint_listlist_sep]

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

implement
{}(*tmp*)
list_is_nil(xs) =
  case+ xs of list_nil() => true | _ =>> false
// end of [list_is_nil]

implement
{}(*tmp*)
list_is_cons(xs) =
  case+ xs of list_cons _ => true | _ =>> false
// end of [list_is_cons]

implement
{x}(*tmp*)
list_is_sing (xs) =
  case+ xs of list_sing (x) => true | _ =>> false
// end of [list_is_sing]

implement
{x}(*tmp*)
list_is_pair (xs) =
  case+ xs of list_pair (x1, x2) => true | _ =>> false
// end of [list_is_pair]

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

implement
{x}(*tmp*)
list_head (xs) =
  let val+list_cons(x, _) = xs in x end
// end of [list_head]
implement
{x}(*tmp*)
list_tail (xs) =
  let val+list_cons(_, xs) = xs in xs end
// end of [list_tail]
implement
{x}(*tmp*)
list_last(xs) = let
//
fun
loop
(
  xs: List1(x)
): (x) = let
  val+list_cons(x, xs) = xs
in
  case+ xs of
  | list_cons _ => loop(xs) | list_nil _ => x
end // end of [loop]
//
in
  $effmask_all(loop(xs))
end // end of [list_last]

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

implement
{x}(*tmp*)
list_head_exn (xs) =
(
case+ xs of
| list_cons(x, _) => x | _ => $raise ListSubscriptExn()
) (* end of [list_head_exn] *)

implement
{x}(*tmp*)
list_tail_exn (xs) =
(
case+ xs of
| list_cons(_, xs) => xs | _ => $raise ListSubscriptExn()
) (* end of [list_tail_exn] *)

implement
{x}(*tmp*)
list_last_exn (xs) =
(
case+ xs of
| list_cons _ => list_last(xs) | _ => $raise ListSubscriptExn()
) (* end of [list_last_exn] *)

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

implement
{a}(*tmp*)
list_nth(xs, i) = let
//
fun
loop
{n,i:nat | i < n} .<i>.
(
  xs: list(a, n), i: int i
) :<> a =
  if i > 0 then let
    val+list_cons(_, xs) = xs in loop(xs, pred(i))
  end else list_head<a>(xs)
//
in
  loop(xs, i)
end // end of [list_nth]

implement
{a}(*tmp*)
list_nth_opt(xs, i) = let
//
fun loop
  {n:nat} .<n>.
(
  xs: list(a, n), i: intGte(0)
) :<> Option_vt(a) =
(
case+ xs of
| list_nil() => None_vt()
| list_cons(x, xs) =>
    if i = 0 then Some_vt(x) else loop(xs, pred(i))
  // end of [list_vt_cons]
) (* end of [loop] *)
//
prval() = lemma_list_param (xs)
//
in
  loop(xs, i)
end // end of [list_nth_opt]

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

implement
{a}(*tmp*)
list_get_at(xs, i) = list_nth<a>(xs, i)
implement
{a}(*tmp*)
list_get_at_opt(xs, i) = list_nth_opt<a>(xs, i)

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

implement
{a}(*tmp*)
list_fset_at
  (xs, i, x_new) = let
//
val
(
xs1, xs2
) =
$effmask_wrt
  (list_split_at<a>(xs, i))
//
val+list_cons(x_old, xs2) = xs2
val xs2 = list_cons{a}(x_new, xs2)
//
in
  $effmask_wrt(list_append1_vt<a>(xs1, xs2))
end // ed of [list_fset_at]

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

implement
{a}(*tmp*)
list_fexch_at
  (xs, i, x_new) = let
val
(
xs1, xs2
) =
$effmask_wrt
  (list_split_at<a>(xs, i))
//
val+list_cons(x_old, xs2) = xs2
val xs2 = list_cons{a}(x_new, xs2)
//
in
  ($effmask_wrt(list_append1_vt<a>(xs1, xs2)), x_old)
end // ed of [list_fexch_at]

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

implement
{a}(*tmp*)
list_insert_at
  (xs, i, x) = let
//
fun loop{n:int}
  {i:nat | i <= n} .<i>.
(
  xs: list(a, n)
, i: int i, x: a
, res: &ptr? >> list(a, n+1)
) :<!wrt> void =
//
if
i > 0
then let
  val+list_cons(x1, xs1) = xs
  val () = res :=
    list_cons{a}{0}(x1, _(*?*))
  val+list_cons
    (_, res1) = res // res1 = res.1
  val () = loop(xs1, i-1, x, res1)
  prval ((*folded*)) = fold@ (res)
in
  // nothing
end // end of [then]
else res := list_cons(x, xs)
//
var
res: ptr
val () =
  $effmask_wrt(loop(xs, i, x, res))
//
in
  res
end // end of [list_insert_at]

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

implement
{a}(*tmp*)
list_remove_at
  (xs, i) = let
//
var x0: a // uninitized
//
in
  $effmask_wrt(list_takeout_at(xs, i, x0))
end // end of [list_remove_at]

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

implement
{a}(*tmp*)
list_takeout_at
  (xs, i, x0) = let
//
fun loop{n:int}
  {i:nat | i < n} .<i>.
(
  xs: list(a, n)
, i: int i, x0: &a? >> a
, res: &ptr? >> list(a, n-1)
) :<!wrt> void = let
//
val+list_cons(x, xs) = xs
//
in
//
if i > 0 then let
  val () =
    res :=
    list_cons{a}{0}(x, _(*?*))
  // end of [val]
  val+list_cons
    (_, res1) = res // res1 = res.1
  val () = loop(xs, i-1, x0, res1)
  prval ((*folded*)) = fold@ (res)
in
  // nothing
end else let
  val () = x0 := x; val () = res := xs
in
  // nothing
end // end of [if]
//
end // end of [loop]
//
var res: ptr?
val () = loop(xs, i, x0, res)
//
in
  res
end // end of [list_takeout_at]

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

implement
{x}(*tmp*)
list_length(xs) = let
//
prval() = lemma_list_param (xs)
//
fun
loop
{i,j:nat} .<i>.
(
xs: list(x, i), j: int j
) :<> int(i+j) = (
//
case+ xs of
| list_cons(_, xs) => loop(xs, j+1) | _ =>> j
//
) (* end of [loop] *)
//
in
  loop(xs, 0)
end // end of [list_length]

(* ****** ****** *)
//
implement
{x}(*tmp*)
list_length_gte
  (xs, n2) =
  (list_length_compare<x>(xs, n2) >= 0)
//
implement
{x}(*tmp*)
list_length_compare
  (xs, n2) =
  loop(xs, n2) where
{
//
fun
loop
{i:nat;j:int} .<i>.
(xs: list(x, i), j: int j) :<> int(sgn(i-j)) =
(
if
(j < 0)
then 1 else
(
case+ xs of
| list_cons
    (_, xs) => loop(xs, j-1)
  // list_cons
| _ (*list_nil*) =>> (if j = 0 then 0 else ~1)
)
) (* end of [loop] *)
//
prval() = lemma_list_param(xs)
//
} (* end of [list_length_compare] *)
//
(* ****** ****** *)

implement
{x}(*tmp*)
list_copy
  (xs) = res where {
//
prval() =
  lemma_list_param(xs)
//
vtypedef res = List0_vt(x)
//
fun loop
  {n:nat} .<n>.
(
  xs: list(x, n)
, res: &res? >> list_vt(x, n)
) :<!wrt> void = let
in
//
case+ xs of
| list_cons
    (x, xs) => let
    val () = res :=
      list_vt_cons{x}{0}(x, _(*?*))
    val+list_vt_cons
      (_, res1) = res // res1 = res.1
    val () = loop(xs, res1)
    prval ((*folded*)) = fold@ (res)
  in
    // nothing
  end // end of [cons]
| list_nil() => res := list_vt_nil()
//
end // end of [loop]
//
var res: res? ; val () = loop(xs, res)
//
} // end of [list_copy]

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

implement
{a}(*tmp*)
list_append
  {m,n} (xs, ys) = let
//
val ys =
__cast(ys) where
{
  extern
  castfn
  __cast(ys: list(a, n)):<> list_vt(a, n)
} // end of [where] // end of [val]
in
//
$effmask_wrt
  (list_of_list_vt(list_append2_vt(xs, ys)))
//
end // end of [list_append]

implement
{a}(*tmp*)
list_append1_vt
  {m,n} (xs, ys) = let
//
val ys =
__cast(ys) where
{
  extern
  castfn
  __cast(ys: list(a, n)):<> list_vt(a, n)
} (* end of [val] *)
//
in
  list_of_list_vt(list_vt_append(xs, ys))
end // end of [list_append1_vt]

implement
{a}(*tmp*)
list_append2_vt
  {m,n} (xs, ys) = let
//
prval() = lemma_list_param (xs)
prval() = lemma_list_vt_param (ys)
//
fun
loop
{m:nat} .<m>.
(
  xs: list(a, m)
, ys: list_vt(a, n)
, res: &ptr? >> list_vt(a, m+n)
) :<!wrt> void =
  case+ xs of
  | list_nil
      () => (res := ys)
    // list_nil
  | list_cons
      (x, xs) => let
      val () = res :=
        list_vt_cons{a}{0}(x, _(*?*))
      val+list_vt_cons
        (_, res1) = res // res1 = res.1
      val () = loop(xs, ys, res1)
      prval ((*folded*)) = fold@ (res)
    in
      // nothing
    end // end of [list_cons]
// end of [loop]
var res: ptr // uninitialized
val () = loop(xs, ys, res)
//
in
  res
end // end of [list_append2_vt]

(* ****** ****** *)
//
implement
{a}(*tmp*)
list_extend(xs, y) =
(
  list_append2_vt<a>(xs, list_vt_sing(y))
) (* end of [list_extend] *)
//
(* ****** ****** *)

implement
{a}(*tmp*)
mul_int_list
{m,n}(m, xs) =
loop{m,0}
(
m, xs, list_vt_nil
) where
{
//
prval() = lemma_list_param(xs)
//
fun
loop
{i,j:nat} .<i>.
(
i0: int(i)
,
xs: list(a, n)
,
res: list_vt(a, j*n)
) :<!wrt> list_vt(a, (i+j)*n) =
if
(i0 = 0)
then
(
  res where
{
  prval
  EQINT() = eqint_make{i,0}()
}
) (* end of [then] *)
else
(
  loop{i-1,j+1}(i0-1, xs, list_append2_vt<a>(xs, res))
) (* end of [else] *)
//
} (* end of [mul_int_list] *)

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

implement
{x}(*tmp*)
list_reverse (xs) =
(
  list_reverse_append2_vt<x>(xs, list_vt_nil)
) // end of [list_reverse]

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

implement
{a}(*tmp*)
list_reverse_append
  {m,n} (xs, ys) = let
//
val ys =
__cast(ys) where
{
  extern
  castfn __cast(ys: list(a, n)):<> list_vt(a, n)
} // end of [where] // end of [val]
//
in
//
$effmask_wrt
(
  list_of_list_vt(list_reverse_append2_vt<a>(xs, ys))
) (* end of [$effmask_wrt] *)
//
end // end of [list_reverse_append]

implement
{a}(*tmp*)
list_reverse_append1_vt
  {m,n} (xs, ys) = let
//
prval() =
lemma_list_vt_param(xs)
//
prval() = lemma_list_param(ys)
//
fun
loop{m,n:nat} .<m>.
(
  xs: list_vt(a, m), ys: list(a, n)
) :<!wrt> list(a, m+n) = let
in
//
case+ xs of
| ~list_vt_nil
    ((*void*)) => ys
  // end of [list_vt_nil]
| @list_vt_cons
    (x, xs1) => let
    val xs1_ = xs1
    val ys =
    __cast(ys) where
    {
      extern
      castfn
      __cast(ys: list(a, n)):<> list_vt(a, n)
    } (* end of [val] *)
    val () = (xs1 := ys)
    prval ((*folded*)) = fold@ (xs)
  in
    loop(xs1_, list_of_list_vt{a}(xs))
  end // end of [list_vt_cons]
//
end // end of [loop]
//
in
  loop(xs, ys)
end // end of [list_reverse_append1_vt]

implement
{a}(*tmp*)
list_reverse_append2_vt
  (xs, ys) = let
//
prval() = lemma_list_param(xs)
prval() = lemma_list_vt_param(ys)
//
fun loop
  {m,n:nat} .<m>.
(
  xs: list(a, m), ys: list_vt(a, n)
) :<!wrt> list_vt(a, m+n) =
(
case+ xs of
| list_nil
    () => ys
  // end of [list_nil]
| list_cons
    (x, xs) => loop(xs, list_vt_cons{a}(x, ys))
  // end of [list_cons]
) (* end of [loop] *)
//
in
  loop(xs, ys)
end // end of [list_reverse_append2_vt]

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

(*
implement
{a}(*tmp*)
list_concat(xss) = let
//
typedef T = List(a)
//
prval() = lemma_list_param(xss)
//
fun
aux{n:nat} .<n>.
(
  xs0: T
, xss: list(T, n)
) :<!wrt> List0_vt(a) = let
//
prval() = lemma_list_param(xs0)
//
in
  case+ xss of
  | list_nil
      () => list_copy(xs0)
    // end of [list_nil]
  | list_cons
      (xs, xss) => let
      val res = aux(xs, xss)
      val ys0 = list_copy<a>(xs0)
    in
      list_vt_append<a>(ys0, res)
    end // end of [list_cons]
end // end of [aux]
//
in
//
case+ xss of
| list_nil
     () => list_vt_nil()
  // list_nil
| list_cons
    (xs, xss) => aux (xs, xss)
  // list_cons
//
end // end of [list_concat]
*)

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

implement
{x}(*tmp*)
list_concat(xss) = let
//
typedef xs = List(x)
//
prval() = lemma_list_param(xss)
//
fnx
aux1
{n1:nat} .<n1,0>.
(
  xss: list(xs, n1)
, res: &ptr? >> List0_vt(x)
) :<!wrt> void =
(
case+ xss of
| list_nil() =>
  (res := list_vt_nil())
| list_cons(xs0, xss) => let
    prval() =
      lemma_list_param(xs0) in aux2(xs0, xss, res)
    // end of [val]
  end // end of [list_cons]
)
and
aux2
{n1,n2:nat} .<n1,n2+1>.
(
  xs0: list(x, n2)
, xss: list(xs, n1)
, res: &ptr? >> List0_vt(x)
) :<!wrt> void = let
in
  case+ xs0 of
  | list_nil() =>
    aux1(xss, res)
  | list_cons(x0, xs1) =>
    {
      val () =
      (
        res :=
        list_vt_cons{x}{0}(x0, _)
      ) (* end of [val] *)
      val+list_vt_cons(_, res1) = res
      val ((*void*)) = aux2(xs1, xss, res1)
      prval ((*folded*)) = fold@(res)
    }
end // end of [aux2]
//
in
//
  let var res: ptr in aux1(xss, res); res end
//
end // end of [list_concat]

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

implement
{a}(*tmp*)
list_take (xs, i) = let
//
fun
loop
{n:int}
{i:nat | i <= n} .<i>.
(
  xs: list(a, n), i: int i
, res: &ptr? >> list_vt(a, i)
) :<!wrt> void =
  if i > 0 then let
    val+list_cons(x, xs) = xs
    val () = res :=
      list_vt_cons{a}{0}(x, _(*?*))
    val+list_vt_cons
      (_, res1) = res // res1 = res.1
    val () = loop(xs, i-1, res1)
    val ((*folded*)) = fold@ (res)
  in
    // nothing
  end else (res := list_vt_nil())
// end of [loop]
//
var res: ptr
val () = loop(xs, i, res)
//
in
  res
end // end of [list_take]

implement
{a}(*tmp*)
list_take_exn
  {n}{i} (xs, i) = let
//
prval() = lemma_list_param(xs)
//
fun loop
  {n:nat}
  {i:nat} .<i>. (
  xs: list(a, n), i: int i
, res: &ptr? >> list_vt(a, j)
) :<!wrt> #[
  j:nat | (i <= n && i == j) || (i > n && n == j)
] bool (i <= n) = let
//
in
//
if i > 0
then let
in
//
case+ xs of
| list_cons
    (x, xs1) =>
    ans where {
//
    val ((*void*)) =
    res :=
    list_vt_cons{a}{0}(x, _)
//
    val+
    list_vt_cons(_, res1) = res
    val ans = loop(xs1, i-1, res1)
//
    prval ((*folded*)) = fold@ (res)
//
  } (* end of [list_cons] *)
| list_nil() => let
    val ((*void*)) =
    res := list_vt_nil() in false(*fail*)
  end // end of [list_nil]
//
end // end of [then]
else let
  val () = res := list_vt_nil() in true(*succ*)
end // end of [else]
// end of [if]
//
end // end of [loop] 
//   
var res: ptr
val ans = loop{n}{i}(xs, i, res)
//
in
//
if ans
then res // i <= n && length (res) == i
else let
  val () = list_vt_free<a>(res) in $raise ListSubscriptExn()
end // end of [if]
//
end (* end of [list_take_exn] *)

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

implement
{a}(*tmp*)
list_drop (xs, i) = let
//
fun loop
  {n:int}
  {i:nat | i <= n} .<i>.
  (xs: list(a, n), i: int i):<> list(a, n-i) =
  if i > 0 then let
    val+list_cons(_, xs) = xs in loop(xs, i-1)
  end else xs // end of [if]
//
in
  loop(xs, i)
end // end of [list_drop]

implement
{a}(*tmp*)
list_drop_exn
  (xs, i) = let
//
prval() = lemma_list_param(xs)
//
fun
loop
{n:nat}{i:nat} .<i>.
(
  xs: list(a, n), i: int i
) :<!exn> [i <= n] list(a, n-i) =
  if i > 0 then (
    case+ xs of
    | list_nil
        () => $raise ListSubscriptExn()
      // list_nil
    | list_cons(_, xs) => loop(xs, i-1)
  ) else (xs) // end of [if]
//
in
  loop(xs, i)
end // end of [list_drop_exn]

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

implement
{x}(*tmp*)
list_split_at
  (xs, i) = let
//
fun
loop
{n:int}
{i:nat | i <= n} .<n>.
(
  xs: list(x, n), i: int i
, res: &ptr? >> list_vt(x, i)
) :<!wrt> list(x, n-i) =
(
if i > 0
  then let
    val+list_cons(x, xs) = xs
    val () =
      res := list_vt_cons{x}{0}(x, _)
    // end of [val]
    val+list_vt_cons(_, res1) = res
    val xs2 = loop(xs, i-1, res1)
    prval ((*folded*)) = fold@ (res)
  in
    xs2
  end // end of [then]
  else let
    val () = res := list_vt_nil() in xs
  end // end of [else]
// end of [if]
)
//
var res: ptr
val xs2 = loop(xs, i, res)
//
in
  (res, xs2)
end // end of [list_split_at]

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

implement
{x}(*tmp*)
list_exists
  (xs) = loop(xs) where
{
//
fun
loop :
$d2ctype(list_exists<x>) = lam(xs) =>
//
case+ xs of
| list_nil() => false
| list_cons(x, xs) =>
    if list_exists$pred<x>(x) then true else loop(xs)
  // end of [list_cons]
//
} (* end of [list_exists] *)

implement
{x}(*tmp*)
list_exists_cloref
  (xs, pred) = let
//
implement(x2)
list_exists$pred<x2>(x2) = pred($UN.cast{x}(x2))
//
in
  list_exists<x>(xs)
end // end of [list_exists_cloref]

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

implement
{x}(*tmp*)
list_iexists_cloref
  {n}(xs, pred) = let
//
prval() = lemma_list_param(xs)
//
fun
loop
{ i,j:nat
| i+j == n
} .<n-i>.
(
  i: int(i), xs: list(x, j)
) :<> bool =
(
  case+ xs of
  | list_nil() => false
  | list_cons(x, xs) =>
      if pred(i, x) then true else loop(i+1, xs)
    // end of [list_cons]
)
//
in
  loop(0, xs)
end // end of [list_iexists_cloref]

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

implement
{x}(*tmp*)
list_forall
  (xs) = loop(xs) where
{
fun
loop :
$d2ctype(list_forall<x>) = lam(xs) =>
//
case+ xs of
| list_nil() => true
| list_cons(x, xs) =>
    if list_forall$pred<x>(x) then loop(xs) else false
  // end of [list_cons]
//
} (* end of [list_forall] *)

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

implement
{x}(*tmp*)
list_forall_cloref
  (xs, pred) = let
//
implement(x2)
list_forall$pred<x2>(x2) = pred($UN.cast{x}(x2))
//
in
  list_forall<x>(xs)
end // end of [list_forall_cloref]

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

implement
{x}(*tmp*)
list_iforall_cloref
  {n}(xs, pred) = let
//
prval() = lemma_list_param(xs)
//
fun
loop
{ i,j:nat
| i+j == n
} .<n-i>.
(
  i: int(i), xs: list(x, j)
) :<> bool =
(
  case+ xs of
  | list_nil() => true
  | list_cons(x, xs) =>
      if pred(i, x) then loop(i+1, xs) else false
    // end of [list_cons]
)
//
in
  loop(0, xs)
end // end of [list_iforall_cloref]

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

implement
{a}(*tmp*)
list_equal$eqfn = gequal_val_val<a>

implement
{x}(*tmp*)
list_equal
(
  xs1, xs2
) = loop(xs1, xs2) where
{
fun
loop :
$d2ctype
(
  list_equal<x>
) = lam(xs1, xs2) =>
//
case+ xs1 of
| list_nil((*void*)) =>
  (
    case+ xs2 of
    | list_nil _ => true
    | list_cons _ => false
  ) // end of [list_nil]
| list_cons(x1, xs1) =>
  (
    case+ xs2 of
    | list_nil() => false
    | list_cons(x2, xs2) => let
        val test =
          list_equal$eqfn<x>(x1, x2)
        // end of [val]
      in
        if test then loop(xs1, xs2) else false
      end // end of [list_cons]
  ) (* end of [list_cons] *)
//
} (* end of [list_equal] *)

implement
{x}(*tmp*)
list_equal_cloref
  (xs1, xs2, eqfn) =
  list_equal<x>(xs1, xs2) where
{
//
implement{y}
list_equal$eqfn(x1, x2) = eqfn($UN.cast(x1), $UN.cast(x2))
//
} (* end of [list_equal_cloref] *)

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

implement
{x}(*tmp*)
list_find
  {n}(xs, x0) = let
//
prval() = lemma_list_param(xs)
//
fun
loop
{ i:nat
| i <= n
} .<n-i>.
(
  xs: list(x, n-i)
, i: int(i), x0: &x? >> opt(x, i >= 0)
) :<!wrt> #[i:int | i < n] int(i) =
(
case+ xs of
| list_nil() =>
  (
    opt_none(x0); ~1
  ) (* list_nil *)
| list_cons(x, xs) =>
  (
    if list_find$pred<x>(x)
      then (x0 := x; opt_some(x0); i) else loop(xs, i+1, x0)
    // end of [if]
  ) (* list_cons *)
) (* end of [loop] *)
//
in
  loop(xs, 0, x0)
end // end of [list_find]

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

implement
{x}(*tmp*)
list_find_exn
  (xs) = loop(xs) where
{
//
fun
loop :
$d2ctype(list_find_exn<x>) = lam(xs) =>
//
case+ xs of
| list_nil() =>
    $raise NotFoundExn()
| list_cons(x, xs) =>
    if list_find$pred<x>(x) then x else loop(xs)
//
} (* end of [list_find_exn] *)

implement
{x}(*tmp*)
list_find_opt
  (xs) = loop(xs) where
{
//
fun
loop :
$d2ctype(list_find_opt<x>) = lam(xs) =>
//
case+ xs of
| list_nil() =>
    None_vt((*void*))
| list_cons(x, xs) =>
    if list_find$pred<x>(x) then Some_vt{x}(x) else loop(xs)
//
} (* end of [list_find_opt] *)

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

implement
{key}(*tmp*)
list_assoc$eqfn = gequal_val_val<key>

implement
{key,itm}
list_assoc
  (kxs, k0, x0) = let
//
fun loop
(
  kxs: List @(key, itm)
, k0: key, x0: &itm? >> opt(itm, b)
) : #[b:bool] bool(b) =
(
  case+ kxs of
  | list_cons
      (kx, kxs) => let
      val iseq =
      list_assoc$eqfn<key>(k0, kx.0)
    in
      if iseq
        then let
          val () = x0 := kx.1
          prval () = opt_some{itm}(x0)
        in
          true
        end // end of [then]
        else loop(kxs, k0, x0)
      // end of [if]
    end // end of [list_cons]
  | list_nil((*void*)) =>
      let prval() = opt_none{itm}(x0) in false end 
    // end of [list_nil]
) (* end of [loop] *)
//
in
  $effmask_all (loop(kxs, k0, x0))
end // end of [list_assoc]

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

implement
{key,itm}
list_assoc_exn
  (kxs, k0) = let
  var x0: itm?
  val ans = list_assoc<key,itm>(kxs, k0, x0)
in
//
if ans
  then let
    prval() = opt_unsome{itm}(x0) in x0
  end // end of [then]
  else let
    prval() = opt_unnone{itm}(x0) in $raise NotFoundExn()
  end // end of [else]
//
end // end of [list_assoc_exn]

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

implement
{key,itm}
list_assoc_opt
  (kxs, k0) = let
  var x0: itm?
  val ans = list_assoc<key,itm>(kxs, k0, x0)
in
//
if ans
  then let
    prval() = opt_unsome{itm}(x0) in Some_vt{itm}(x0)
  end // end of [then]
  else let
    prval() = opt_unnone{itm}(x0) in None_vt((*void*))
  end // end of [else]
//
end // end of [list_assoc_opt]

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

implement
{x}(*tmp*)
list_filter{n}(xs) = let
//
prval() = lemma_list_param(xs)
//
fun
loop
{n:nat} .<n>.
(
  xs: list(x, n)
, res: &ptr? >> listLte_vt(x, n)
) : void = (
//
case+ xs of
| list_nil
  (
    // argless
  ) => (res := list_vt_nil)
| list_cons
    (x, xs) => let
    val test = list_filter$pred<x>(x)
  in
    case+ test of
    | true => () where
      {
        val () = res :=
          list_vt_cons{x}{0}(x, _(*?*))
        val+list_vt_cons
          (_, res1) = res // res1 = res.1
        val () = loop(xs, res1)
        prval ((*folded*)) = fold@ (res)
      } (* end of [true] *)
    | false => loop(xs, res)
  end // end of [list_cons]
//
) (* end of [loop] *)
//
var res: ptr
val () = loop(xs, res)
//
in
  res(*listLte_vt(x, n)*)
end // end of [list_filter]

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

implement
{x}(*tmp*)
list_labelize
  (xs) = res where {
//
typedef ix = @(int, x)
//
prval() = lemma_list_param(xs)
//
fun
loop
{n:nat} .<n>.
(
  xs: list(x, n), i: int
, res: &ptr? >> list_vt(ix, n)
) :<!wrt> void = let
in
//
case+ xs of
| list_nil
    () =>
    (res := list_vt_nil)
  // end of [list_nil]
| list_cons
    (x, xs) => () where
  {
    val () =
    res :=
    list_vt_cons{ix}{0}(_, _)
    val+
    list_vt_cons(ix, res1) = res
    val () = ix.0 := i and () = ix.1 := x
    val () = loop(xs, i+1, res1)
    prval ((*folded*)) = fold@ (res)
  } (* end of [list_cons] *)
//
end // end of [loop]
//
var res: ptr ; val () = loop(xs, 0, res)
//
} // end of [list_labelize]

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

implement
{x}(*tmp*)
list_app (xs) = let
//
prval() = lemma_list_param(xs)
//
fun
loop{n:nat} .<n>. (xs: list(x, n)): void =
(
case+ xs of
| list_nil() => ()
| list_cons(x, xs) => (list_app$fwork(x); loop(xs))
) (* end of [loop] *)
//
in
  loop(xs)
end // end of [list_app]

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

implement
{x}(*tmp*)
list_app_fun
  (xs, fwork) = let
//
prval() = lemma_list_param(xs)
//
fun
loop{n:nat} .<n>.
(
  xs: list(x, n), fwork: (x) -<fun1> void
) : void = (
//
case+ xs of
| list_nil() => ()
| list_cons(x, xs) => (fwork(x); loop(xs, fwork))
//
) (* end of [loop] *)
//
in
  loop(xs, fwork)
end // end of [list_app_fun]

implement
{x}(*tmp*)
list_app_cloref
  (xs, fwork) = let
//
prval() = lemma_list_param(xs)
//
fun
loop
{n:nat} .<n>.
(
  xs: list(x, n)
, fwork: (x) -<cloref1> void
) : void = (
//
case+ xs of
| list_nil() => ()
| list_cons(x, xs) => (fwork(x); loop(xs, fwork))
//
) (* end of [loop] *)
//
in
  loop(xs, fwork)
end // end of [list_app_cloref]

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

implement
{x}{y}(*tmp*)
list_map{n}(xs) = let
//
prval() = lemma_list_param(xs)
//
fun
loop
{n:nat} .<n>.
(
  xs: list(x, n)
, res: &ptr? >> list_vt(y, n)
) : void = (
  case+ xs of
  | list_nil
      ((*void*)) =>
      (res := list_vt_nil)
    // list_nil
  | list_cons(x, xs) => let
      val y =
        list_map$fopr<x><y>(x)
      val () = res :=
        list_vt_cons{y}{0}(y, _(*?*))
      val+list_vt_cons
        (_, res1) = res // res1 = res.1
      val () = loop(xs, res1)
      prval ((*folded*)) = fold@ (res)
    in
      // nothing
    end // end of [list_cons]
) // end of [loop]
//
var res: ptr
val () = loop(xs, res)
//
in
  res(*list_vt(y, n)*)
end // end of [list_map]

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

implement
{x}{y}(*tmp*)
list_map_fun
  (xs, fopr) = let
//
implement
{x2}{y2}
list_map$fopr(x2) =
  $UN.castvwtp0{y2}(fopr($UN.cast{x}(x2)))
//
in
  list_map<x><y>(xs)
end // end of [list_map_fun]

implement
{x}{y}(*tmp*)
list_map_clo
  (xs, fopr) = let
//
val fopr =
  $UN.cast{(x) -<cloref1> y}(addr@fopr)
//
implement
{x2}{y2}
list_map$fopr(x2) =
  $UN.castvwtp0{y2}(fopr($UN.cast{x}(x2)))
//
in
  list_map<x><y>(xs)
end // end of [list_map_clo]

implement
{x}{y}(*tmp*)
list_map_cloref
  (xs, fopr) = let
//
implement
{x2}{y2}
list_map$fopr(x2) =
  $UN.castvwtp0{y2}(fopr($UN.cast{x}(x2)))
//
in
  list_map<x><y>(xs)
end // end of [list_map_cloref]

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

(*
implement
{x}{y}(*tmp*)
list_map_funenv
  {v}{vt}{n}{fe}
  (pfv | xs, f, env) = let
//
prval() =
  lemma_list_param(xs)
//
vtypedef ys = List0_vt(y)
//
fun
loop
{n:nat} .<n>.
(
  pfv: !v
| xs: list(x, n)
, f: (!v | x, !vt) -<fun,fe> y
, env: !vt
, res: &ys? >> list_vt(y, n)
) :<!wrt,fe> void = let
in
//
case+ xs of
| list_nil
    () => (res := list_vt_nil())
  // list_nil
| list_cons
    (x, xs) => let
    val y = f (pfv | x, env)
    val () = res :=
      list_vt_cons{y}{0}(y, _(*?*))
    val+list_vt_cons
      (_, res1) = res // res1 = res.1
    val () = loop(pfv | xs, f, env, res1)
    prval ((*folded*)) = fold@ (res)
  in
    (*nothing*)
  end // end of [list_vt_cons]
//
end // end of [loop]
//
var res: ys // uninitialized
val () = loop(pfv | xs, f, env, res)
//
in
  res(*list_vt(y,n)*)
end // end of [list_map_funenv]
*)

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

implement
{x}{y}
list_imap{n}(xs) = let
//
prval() = lemma_list_param(xs)
//
fun loop
  {n:nat}{i:nat} .<n>.
(
  xs: list(x, n), i: int(i)
, res: &ptr? >> list_vt(y, n)
) : void = (
  case+ xs of
  | list_nil
      () => (res := list_vt_nil)
    // list_nil
  | list_cons
      (x, xs) => let
      val y =
        list_imap$fopr<x><y>(i, x)
      val () = res :=
        list_vt_cons{y}{0}(y, _(*?*))
      val+list_vt_cons
        (_, res1) = res // res1 = res.1
      val () = loop(xs, i+1, res1)
      prval ((*void*)) = fold@ (res)
    in
      // nothing
    end // end of [list_cons]
) // end of [loop]
//
var res: ptr
val () = loop(xs, 0, res)
//
in
  res(*list_vt(y, n)*)
end // end of [list_imap]

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

implement
{x}{y}
list_mapopt{n}(xs) = let
//
prval() = lemma_list_param(xs)
//
fun
loop
{n:nat} .<n>.
(
  xs: list(x, n)
, res: &ptr? >> listLte_vt(y, n)
) : void = let
in
//
case+ xs of
| list_nil
    () =>
    (res := list_vt_nil)
  // list_nil
| list_cons(x, xs) => let
    val opt =
      list_mapopt$fopr<x><y>(x)
    // end of [val]
  in
    case+ opt of
    | ~Some_vt(y) => let
        val () = res :=
          list_vt_cons{y}{0}(y, _(*?*))
        val+list_vt_cons
          (_, res1) = res // res1 = res.1
        val () = loop(xs, res1)
        prval ((*folded*)) = fold@ (res)
      in
        // nothing
      end // end of [Some_vt]
    | ~None_vt((*void*)) => loop(xs, res)
  end // end of [list_cons]
//
end // end of [loop]
//
var res: ptr
val () = loop(xs, res)
//
in
  res(*listLte_vt(y, n)*)
end // end of [list_mapopt]

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

(*
implement
{x}{y}(*tmp*)
list_mapopt_funenv
  {v}{vt}{n}{fe}
  (pfv | xs, f0, env) = let
//
prval() =
  lemma_list_param(xs)
//
vtypedef ys = List0_vt(y)
//
fun
loop
{n:nat} .<n>.
(
  pfv: !v
| xs: list(x, n)
, f0: (!v | x, !vt) -<fun,fe> Option_vt(y)
, env: !vt
, res: &ys? >> listLte_vt(y, n)
) :<!wrt,fe> void = let
in
//
case+ xs of
| list_nil
    () =>
    (res := list_vt_nil())
  // end of [list_nil]
| list_cons
    (x, xs) => let
    val opt = f0(pfv | x, env)
  in
    case+ opt of
    | ~None_vt() =>
      (
        loop(pfv | xs, f0, env, res)
      ) (* end of [None_vt] *)
    | ~Some_vt(y) => let
        val () = res :=
          list_vt_cons{y}{0}(y, _(*?*))
        val+list_vt_cons
          (_, res1) = res // res1 = res.1
        val () = loop(pfv | xs, f0, env, res1)
        prval ((*folded*)) = fold@ (res)
      in
        (*nothing*)
      end // end of [Some_vt]
  end // end of [list_vt_cons]
//
end // end of [loop]
//
var res: ys // uninitialized
val () = loop(pfv | xs, f0, env, res)
//
in
  res(*listLte_vt(y,n)*)
end // end of [list_mapopt_funenv]
*)

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

implement
{x1,x2}{y}
list_map2
  {n1,n2}(xs1, xs2) = let
//
prval() = lemma_list_param(xs1)
prval() = lemma_list_param(xs2)
//
fun
loop{n1,n2:nat}
(
  xs1: list(x1, n1)
, xs2: list(x2, n2)
, res: &ptr? >> list_vt(y, min(n1,n2))
) : void = let
in
//
case+ (xs1, xs2) of
| (list_cons(x1, xs1),
   list_cons(x2, xs2)) =>
  {
    val y =
    list_map2$fopr<x1,x2><y>(x1, x2)
    val () =
      res := list_vt_cons{y}{0}(y, _)
    val+list_vt_cons(_, res1) = res
    val ((*void*)) = loop(xs1, xs2, res1)
    prval ((*folded*)) = fold@ (res)
  } (* end of [cons, cons] *)
| (_, _) =>> (res := list_vt_nil((*void*)))
//
end // end of [loop]
//
var res: ptr
val ((*void*)) = loop(xs1, xs2, res)
//
in
  res
end // end of [list_map2]

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

implement
{x}(*tmp*)
list_tabulate
  (n) = let
//
fun loop
  {n:int}
  {i:nat | i <= n}
  .<n-i>. (
  n: int n, i: int i
, res: &ptr? >> list_vt(x, n-i)
) : void =
  if n > i then let
    val x =
      list_tabulate$fopr<x>(i)
    val () = res :=
      list_vt_cons{x}{0}(x, _(*?*))
    val+list_vt_cons
      (_, res1) = res // res1 = res.1
    val () = loop(n, succ(i), res1)
    prval ((*folded*)) = fold@ (res)
  in
    // nothing
  end else (res := list_vt_nil)
//
in
//
let var res: ptr; val () = loop(n, 0, res) in res end
//
end // end of [list_tabulate]

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

implement
{a}(*tmp*)
list_tabulate_fun
  (n, fopr) = let
//
val fopr =
$UN.cast{int -> a}(fopr)
//
implement(a2)
list_tabulate$fopr<a2>(n) = $UN.castvwtp0{a2}(fopr(n))
//
in
  list_tabulate<a>(n)
end // end of [list_tabulate_fun]

implement
{a}(*tmp*)
list_tabulate_clo
  (n, fopr) = let
//
val fopr =
$UN.cast{int -<cloref1> a}(addr@fopr)
//
implement(a2)
list_tabulate$fopr<a2>(n) = $UN.castvwtp0{a2}(fopr(n))
//
in
  list_tabulate<a>(n)
end // end of [list_tabulate_clo]

implement
{a}(*tmp*)
list_tabulate_cloref
  (n, fopr) = let
//
val fopr =
$UN.cast{int -<cloref1> a}(fopr)
//
implement(a2)
list_tabulate$fopr<a2>(n) = $UN.castvwtp0{a2}(fopr(n))
//
in
  list_tabulate<a>(n)
end // end of [list_tabulate_cloref]

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

implement
{x,y}
list_zip
  (xs, ys) = let
//
typedef xy = @(x, y)
//
implement
list_zipwith$fopr<x,y><xy>(x, y) = @(x, y)
//
in
  $effmask_all(list_zipwith<x,y><xy>(xs, ys))
end // end of [list_zip]

implement
{x,y}{xy}
list_zipwith
(
  xs, ys
) = res where
{
//
prval() = lemma_list_param(xs)
prval() = lemma_list_param(ys)
//
fun
loop
{m,n:nat} .<m>.
(
  xs: list(x, m)
, ys: list(y, n)
, res: &ptr? >> list_vt(xy, min(m,n))
) : void = (
//
case+ xs of
| list_nil() =>
    (res := list_vt_nil)
  // list_nil
| list_cons(x, xs) =>
  (
  case+ ys of
  | list_nil() =>
      (res := list_vt_nil)
    // list_nil
  | list_cons
      (y, ys) =>
      fold@(res) where
    {
      val xy =
        list_zipwith$fopr<x,y><xy>(x, y)
      // end of [val]
      val () = res :=
        list_vt_cons{xy}{0}(xy, _(*res*))
      val+list_vt_cons
        (xy, res1) = res // res1 = res.1
      val ((*tailrec*)) = loop(xs, ys, res1)
    } (* end of [list_cons] *)
  ) // end of [list_cons]
//
) (* end of [loop] *)
//
var res: ptr
val ((*void*)) = loop(xs, ys, res)
//
} (* end of [list_zipwith] *)

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

implement
{x,y}
list_cross
  (xs, ys) = let
//
typedef xy = @(x, y)
//
implement
list_crosswith$fopr<x,y><xy>(x, y) = @(x, y)
//
in
  $effmask_all (list_crosswith<x,y><xy>(xs, ys))
end // end of [list_cross]

implement
{x,y}{xy}
list_crosswith
  (xs, ys) = let
//
prval() = lemma_list_param(xs)
prval() = lemma_list_param(ys)
//
fnx
loop1
{m,n:nat} .<m,0,0>.
(
  xs: list(x, m)
, ys: list(y, n)
, res: &ptr? >> list_vt(xy, m*n)
) : void = let
in
  case+ xs of
  | list_cons
      (x, xs) =>
      loop2(xs, ys, x, ys, res)
    // list_cons
  | list_nil() => (res := list_vt_nil())
end // end of [loop1]

and
loop2
{m,n,n2:nat} .<m,n2,1>.
(
  xs: list(x, m)
, ys: list(y, n)
, x: x, ys2: list(y, n2)
, res: &ptr? >> list_vt(xy, m*n+n2)
) : void = let
in
//
case+ ys2 of
| list_cons
    (y, ys2) => let
    val xy = 
      list_crosswith$fopr<x,y><xy>
        (x, y)
      // list_crosswith$fopr
    // end of [val]
    val () = res :=
      list_vt_cons{xy}{0}(xy, _(*?*))
    val+list_vt_cons (_, res1) = res
    val () = loop2(xs, ys, x, ys2, res1)
    prval () = mul_gte_gte_gte{m,n}()
  in
    fold@ (res) // nothing
  end // end of [list_cons]
| list_nil() => loop1(xs, ys, res)
//
end // end of [loop2]
//
in
  let var res: ptr; val () = loop1(xs, ys, res) in res end
end // end of [list_crosswith]

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

implement
{x}(*tmp*)
list_foreach(xs) = let
//
var env: void = () in list_foreach_env<x><void>(xs, env)
//
end // end of [list_foreach]

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

implement
{x}{env}
list_foreach_env
  (xs, env) = let
//
prval() = lemma_list_param(xs)
//
fun
loop
{n:nat} .<n>.
(
  xs: list(x, n), env: &env
) : void = let
in
//
case+ xs of
| list_nil() => ()
| list_cons(x, xs) => let
    val test =
      list_foreach$cont<x><env>(x, env)
    // end of [val]
  in
    if test then let
      val () =
      list_foreach$fwork<x><env>(x, env)
    in
      loop(xs, env)
    end else () // end of [if]
  end // end of [list_cons]
//
end // end of [loop]
//
in
  loop(xs, env)
end // end of [list_foreach_env]

(* ****** ****** *)
//
implement
{x}{env}
list_foreach$cont(x, env) = true
//
(* ****** ****** *)

implement
{x}(*tmp*)
list_foreach_fun
  (xs, fwork) = let
//
fun
loop(xs: List(x)): void =
//
case+ xs of
| list_nil() => ()
| list_cons(x, xs) => (fwork(x); loop(xs))
//
in
  $effmask_all (loop(xs))
end // end of [list_foreach_fun]

(* ****** ****** *)
//
implement
{x}(*tmp*)
list_foreach_clo
  (xs, fwork) =
(
$effmask_all
  (list_foreach_cloref<x>(xs, $UN.cast(addr@fwork)))
) (* list_foreach_clo *)
implement
{x}(*tmp*)
list_foreach_vclo
  (pf | xs, fwork) =
(
$effmask_all
  (list_foreach_cloref<x>(xs, $UN.cast(addr@fwork)))
) (* list_foreach_vclo *)
//
(* ****** ****** *)

implement
{x}(*tmp*)
list_foreach_cloptr
  (xs, fwork) =
(
$effmask_all
  (list_foreach_cloref<x>(xs, $UN.castvwtp1(fwork)))
) (* list_foreach_cloptr *)

implement
{x}(*tmp*)
list_foreach_vcloptr
  (pf | xs, fwork) =
(
$effmask_all
  (list_foreach_cloref<x>(xs, $UN.castvwtp1(fwork)))
) (* list_foreach_vcloptr *)

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

implement
{x}(*tmp*)
list_foreach_cloref
  (xs, fwork) = let
//
fun
loop(xs: List(x)): void =
//
case+ xs of
| list_nil() => ()
| list_cons(x, xs) => (fwork(x); loop(xs))
//
in
  $effmask_all (loop(xs))
end // end of [list_foreach_cloref]

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

implement
{x}(*tmp*)
list_foreach_funenv
  {v}{vt}{fe}
  (pfv | xs, f0, env) = let
//
prval() = lemma_list_param(xs)
//
fun
loop{n:nat} .<n>.
(
  pfv: !v
| xs: list(x, n)
, f0: (!v | x, !vt) -<fun,fe> void
, env: !vt
) :<fe> void =
(
  case+ xs of
  | list_nil() => ()
  | list_cons(x, xs) => let
      val () = f0(pfv | x, env) in loop(pfv | xs, f0, env)
    end // end of [list_cons]
) (* end of [loop] *)
//
in
  loop(pfv | xs, f0, env)
end // end of [list_foreach_funenv]

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

implement
{x,y}(*tmp*)
list_foreach2(xs, ys) = let
  var env: void = () in list_foreach2_env<x,y><void>(xs, ys, env)
end // end of [list_foreach2]

implement
{x,y}{env}
list_foreach2_env
  (xs, ys, env) = let
//
prval() = lemma_list_param(xs)
prval() = lemma_list_param(ys)
//
fun loop
  {m,n:nat} .<m>. (
  xs: list(x, m), ys: list(y, n), env: &env
) : void = let
in
//
case+ xs of
| list_nil() => ()
| list_cons(x, xs) => (
  case+ ys of
  | list_nil() => ()
  | list_cons(y, ys) => let
      val test =
        list_foreach2$cont<x,y><env>(x, y, env)
      // end of [val]
    in
      if test then let
        val () = list_foreach2$fwork<x,y><env>(x, y, env)
      in
        loop(xs, ys, env)
      end else () // end of [if]
    end // end of [list_cons]
  ) (* end of [list_cons] *)
//
end // end of [loop]
//
in
  loop(xs, ys, env)
end // end of [list_foreach2_env]

(* ****** ****** *)
//
implement
{x,y}{env}
list_foreach2$cont(x, y, env) = true
//
(* ****** ****** *)

implement
{x}(*tmp*)
list_iforeach
  (xs) = let
  var env: void = ()
in
  list_iforeach_env<x><void>(xs, env)
end // end of [list_iforeach]

implement
{x}{env}
list_iforeach_env
  (xs, env) = let
//
prval() = lemma_list_param(xs)
//
fun
loop
{n:nat}{i:nat} .<n>.
(
  i: int i, xs: list(x, n), env: &env
) : intBtwe(i,n+i) = (
//
case+ xs of
| list_nil() => (i)
| list_cons(x, xs) => let
    val test =
      list_iforeach$cont<x><env>(i, x, env)
    // end of [test]
  in
    if test then let
      val () = list_iforeach$fwork<x><env>(i, x, env)
    in
      loop(succ(i), xs, env)
    end else (i) // end of [if]
  end // end of [list_cons]
//
) (* end of [loop] *)
//
in
  loop(0, xs, env)
end // end of [list_iforeach_env]

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

implement
{x}{env}(*tmp*)
list_iforeach$cont(i, x, env) = true

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

implement
{x}(*tmp*)
list_iforeach_cloref
  {n}(xs, fwork) = let
//
prval() = lemma_list_param(xs)
//
fun
loop
{
  i,j:nat
| i+j == n
} .<n-i>.
(
  i: int(i), xs: list(x, j)
) : void =
//
case+ xs of
| list_nil() => ()
| list_cons(x, xs) => (fwork (i, x); loop(i+1, xs))
//
in
  loop(0, xs)
end // end of [list_iforeach_cloref]

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

implement
{x}(*tmp*)
list_iforeach_funenv
  {v}{vt}{n}{fe}
(
  pfv | xs, fwork, env
) = let
//
prval() = lemma_list_param(xs)
//
fun
loop
{ i:nat
| i <= n
} .<n-i>.
(
  pfv: !v
| i: int i
, xs: list(x, n-i)
, fwork: (!v | natLt(n), x, !vt) -<fun,fe> void
, env: !vt
) :<fe> int n = (
//
case+ xs of
| list_nil() => i
| list_cons(x, xs) => let
    val () = fwork (pfv | i, x, env) in loop(pfv | i+1, xs, fwork, env)
  end // end of [list_cons]
) (* end of [loop] *)
//
in
  loop(pfv | 0, xs, fwork, env)
end // end of [list_iforeach_funenv]

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

implement
{x,y}(*tmp*)
list_iforeach2
  (xs, ys) = let
  var env: void = ()
in
  list_iforeach2_env<x,y><void>(xs, ys, env)
end // end of [list_iforeach2]

implement
{x,y}{env}
list_iforeach2_env
  (xs, ys, env) = let
//
prval() = lemma_list_param(xs)
prval() = lemma_list_param(ys)
//
fun loop
  {m,n:nat}{i:nat} .<m>.
(
  i: int i, xs: list(x, m), ys: list(y, n), env: &env
) : intBtwe(i, min(m,n)+i) = let
in
//
case+ xs of
| list_nil() => i // the number of processed elements
| list_cons(x, xs) => (
  case+ ys of
  | list_nil() => (i)
  | list_cons(y, ys) => let
      val test =
        list_iforeach2$cont<x,y><env>(i, x, y, env)
      // end of [val]
    in
      if test
        then let
          val ((*void*)) =
            list_iforeach2$fwork<x,y><env>(i, x, y, env)
          // end of [val]
        in
          loop(succ(i), xs, ys, env)
        end // end of [then]
        else (i) // end of [else]
    end // end of [list_cons]
  ) (* end of [list_cons] *)
//
end // end of [loop]
//
in
  loop(0, xs, ys, env)
end // end of [list_iforeach2_env]

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

implement
{x,y}{env}
list_iforeach2$cont(i, x, y, env) = true

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

implement
{res}{x}
list_foldleft
  (xs, ini) = let
//
prval() = lemma_list_param(xs)
//
fun loop
  {n:nat} .<n>.
(
  xs: list(x, n), res: res
) : res =
  case+ xs of
  | list_nil() => res
  | list_cons(x, xs) => let
      val res =
        list_foldleft$fopr<res><x>(res, x)
      // end of [val]
    in
      loop(xs, res)
    end // end of [list_cons]
// end of [loop]
//
in
  loop(xs, ini)
end // end of [list_foldleft]

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

implement
{res}{x}
list_foldleft_cloref
  (xs, ini, fopr) = let
//
implement
{res2}{x2}
list_foldleft$fopr
  (res2, x2) =
(
$UN.castvwtp0{res2}
  (fopr($UN.castvwtp0{res}(res2), $UN.cast{x}(x2)))
)
//
in
  list_foldleft<res><x>(xs, ini)
end // end of [list_foldleft_cloref]

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

implement
{x}{res}
list_foldright
  (xs, snk) = let
//
prval() =
lemma_list_param(xs)
//
fun aux
  {n:nat} .<n>.
(
  xs: list(x, n), res: res
) : res =
  case+ xs of
  | list_nil() => res
  | list_cons(x, xs) =>
      list_foldright$fopr<x><res>(x, aux(xs, res))
    // end of [list_cons]
// end of [aux]
//
in
  aux (xs, snk)
end // end of [list_foldright]

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

implement
{x}{res}
list_foldright_cloref
  (xs, fopr, snk) = let
//
implement
{x2}{res2}
list_foldright$fopr
  (x2, res2) =
(
$UN.castvwtp0{res2}
  (fopr($UN.cast{x}(x2), $UN.castvwtp0{res}(res2)))
)
//
in
  list_foldright<x><res>(xs, snk)
end // end of [list_foldright_cloref]

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

implement
{a}(*tmp*)
list_is_ordered
  (xs) = let
//
fun
loop
(
x0: a, xs: List(a)
) : bool =
(
//
case+ xs of
| list_nil() => true
| list_cons(x1, xs) => let
    val
    sgn =
    gcompare_val_val<a>(x0, x1)
  in
    if sgn <= 0
      then loop(x1, xs) else false
    // end of [if]
  end // end of [list_cons]
//
) (* end of [loop] *)
//
in
  case+ xs of
  | list_nil() => true
  | list_cons(x0, xs) => loop(x0, xs)
end // end of [list_is_ordered]
  
(* ****** ****** *)

implement
{a}(*tmp*)
list_mergesort$cmp
  (x1, x2) = gcompare_val_val<a>(x1, x2)
// end of [list_mergesort$cmp]

implement
{a}(*tmp*)
list_mergesort
  (xs) = let
//
implement
list_vt_mergesort$cmp<a>
  (x1, x2) =
  list_mergesort$cmp<a>(x1, x2)
//
in
//
let val xs =
  list_copy<a>(xs) in list_vt_mergesort<a>(xs)
end // end of [let]
//
end // end of [list_mergesort]

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

implement
{a}(*tmp*)
list_mergesort_fun
  (xs, cmp) = let
//
implement
{a2}(*tmp*)
list_mergesort$cmp
  (x1, x2) = let
//
typedef
cmp2 = cmpval(a2)
//
val cmp2 = $UN.cast{cmp2}(cmp) in cmp2(x1, x2)
//
end // end of [list_mergesort$cmp]
//
in
  list_mergesort<a>(xs)
end // end of [list_mergesort_fun]

implement
{a}(*tmp*)
list_mergesort_cloref
  (xs, cmp) = let
//
implement
{a2}(*tmp*)
list_mergesort$cmp
  (x1, x2) = let
//
typedef
cmp2 = (a2, a2) -<cloref> int
//
val cmp2 =
  $UN.cast{cmp2}(cmp) in cmp2 (x1, x2)
//
end // end of [list_mergesort$cmp]
//
in
  list_mergesort<a>(xs)
end // end of [list_mergesort_cloref]

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

implement
{a}(*tmp*)
list_quicksort$cmp
  (x1, x2) = gcompare_val_val<a>(x1, x2)
// end of [list_quicksort$cmp]

implement
{a}(*tmp*)
list_quicksort
  (xs) = let
//
implement
list_vt_quicksort$cmp<a>
  (x1, x2) =
  list_quicksort$cmp<a>(x1, x2)
//
in
//
let val xs =
  list_copy<a>(xs) in list_vt_quicksort<a>(xs)
end // end of [let]
//
end // end of [list_quicksort]

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

implement
{a}(*tmp*)
list_quicksort_fun
  (xs, cmp) = let
//
implement
{a2}(*tmp*)
list_quicksort$cmp
  (x1, x2) = let
//
typedef
cmp2 = cmpval(a2)
//
val cmp2 = $UN.cast{cmp2}(cmp) in cmp2(x1, x2)
//
end // end of [list_quicksort$cmp]
//
in
  list_quicksort<a>(xs)
end // end of [list_quicksort_fun]

implement
{a}(*tmp*)
list_quicksort_cloref
  (xs, cmp) = let
//
implement
{a2}(*tmp*)
list_quicksort$cmp
  (x1, x2) = let
//
typedef
cmp2 = (a2, a2) -<cloref> int
//
val cmp2 = $UN.cast{cmp2}(cmp) in cmp2(x1, x2)
//
end // end of [list_quicksort$cmp]
//
in
  list_quicksort<a>(xs)
end // end of [list_quicksort_cloref]

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

implement
{a}(*tmp*)
streamize_list_elt
  (xs) = let
//
fun
auxmain
(
  xs: List(a)
) : stream_vt(a) = $ldelay
(
  case+ xs of
  | list_nil() => stream_vt_nil()
  | list_cons(x, xs) => stream_vt_cons(x, auxmain(xs))
) : stream_vt_con(a) // $ldelay
//
in
  $effmask_all(auxmain(xs))
end // end of [streamize_list_elt]

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

implement
{a}(*tmp*)
streamize_list_choose2
  (xs) = let
//
typedef a2 = @(a, a)
//
fun
auxmain
(
  xs: List(a)
) : stream_vt(a2) = $ldelay
(
  case+ xs of
  | list_nil() => stream_vt_nil()
  | list_cons(x, xs) => !(auxmain2(x, xs))
) : stream_vt_con(@(a, a)) // $ldelay
//
and
auxmain2
(
  x0: a, xs: List(a)
) : stream_vt(a2) = $ldelay
(
  case+ xs of
  | list_nil() => !(auxmain(xs))
  | list_cons(x, xs) => stream_vt_cons((x0, x), auxmain2(x0, xs))
) : stream_vt_con(@(a, a)) // $ldelay
//
in
  $effmask_all(auxmain(xs))
end // end of [streamize_list_choose2]

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

implement
{a,b}(*tmp*)
streamize_list_zip
  (xs, ys) = let
//
fun
auxmain
(
  xs: List(a)
, ys: List(b)
) : stream_vt(@(a, b)) = $ldelay
(
case+ xs of
| list_nil() =>
    stream_vt_nil()
  // end of [list_nil]
| list_cons(x, xs) =>
  (
    case+ ys of
    | list_nil() => stream_vt_nil()
    | list_cons(y, ys) => stream_vt_cons((x, y), auxmain(xs, ys))
  ) (* end of [list_cons] *)
) : stream_vt_con(@(a, b)) // auxmain
//
in
  $effmask_all(auxmain(xs, ys))
end // end of [streamize_list_zip]

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

implement
{a,b}(*tmp*)
streamize_list_cross
  (xs, ys) = let
//
fun
auxone
(
  x0: a
, ys: List(b)
) : stream_vt(@(a, b)) = $ldelay
(
case+ ys of
| list_nil() =>
    stream_vt_nil()
  // end of [list_nil]
| list_cons(y, ys) =>
    stream_vt_cons((x0, y), auxone(x0, ys))
) : stream_vt_con(@(a, b))
//
fun
auxmain
(
  xs: List(a)
, ys: List(b)
) : stream_vt(@(a, b)) = $ldelay
(
case+ xs of
| list_nil() =>
    stream_vt_nil()
  // end of [list_nil]
| list_cons(x0, xs) =>
    !(stream_vt_append(auxone(x0, ys), auxmain(xs, ys)))
) : stream_vt_con(@(a, b))
//
in
  $effmask_all(auxmain(xs, ys))
end // end of [streamize_list_cross]

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

(* end of [list.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/list_vt.atxt
** Time of generation: Fri Aug 18 03:30:02 2017
*)

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

(* Author: Hongwei Xi *)
(* Start time: Feburary, 2012 *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)

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

absvtype
List0_vt_(a:vt@ype+) = List0_vt(a)

(* ****** ****** *)
//
implement
{a}(*tmp*)
list_vt_make_sing(x) =
  list_vt_cons{a}(x, list_vt_nil())
implement
{a}(*tmp*)
list_vt_make_pair(x1, x2) =
(
  list_vt_cons{a}
  (
    x1, list_vt_cons{a}(x2, list_vt_nil())
  )
) (* list_vt_cons *)
//
(* ****** ****** *)
//
implement
{a}(*tmp*)
print_list_vt(xs) =
  fprint_list_vt<a>(stdout_ref, xs)
//
implement
{a}(*tmp*)
prerr_list_vt(xs) =
  fprint_list_vt<a>(stderr_ref, xs)
//
(* ****** ****** *)
//
implement
{}(*tmp*)
fprint_list_vt$sep
  (out) = fprint_list$sep<(*none*)>(out)
//
implement
{a}(*tmp*)
fprint_list_vt
  (out, xs) = let
//
implement(env)
list_vt_iforeach$fwork<a><env>
  (i, x, env) = let
//
val () =
if (i > 0)
  then fprint_list_vt$sep<(*none*)>(out)
// end of [val]
//
in
  fprint_ref<a>(out, x)
end // end of [list_iforeach$fwork]
//
val _(*n*) = list_vt_iforeach<a>(xs)
//
in
  // nothing
end // end of [fprint_list_vt]

implement
{a}(*tmp*)
fprint_list_vt_sep
  (out, xs, sep) = let
//
implement
fprint_list_vt$sep<(*none*)>
  (out) = fprint_string(out, sep)
//
in
  fprint_list_vt<a>(out, xs)
end // end of [fprint_list_vt_sep]

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

implement
{x}(*tmp*)
list_vt_is_nil(xs) =
  case+ xs of list_vt_nil () => true | _ =>> false
// end of [list_vt_is_nil]

implement
{x}(*tmp*)
list_vt_is_cons(xs) =
  case+ xs of list_vt_cons _ => true | _ =>> false
// end of [list_vt_is_cons]

implement
{x}(*tmp*)
list_vt_is_sing (xs) =
  case+ xs of list_vt_sing (x) => true | _ =>> false
// end of [list_vt_is_sing]

implement
{x}(*tmp*)
list_vt_is_pair (xs) =
  case+ xs of list_vt_pair (x1, x2) => true | _ =>> false
// end of [list_vt_is_pair]

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

implement
{}(*tmp*)
list_vt_unnil (xs) = let
  val+~list_vt_nil () = xs in (*nothing*)
end // end of [list_vt_unnil]

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

implement
{a}(*tmp*)
list_vt_uncons(xs) = let
  val+~list_vt_cons(x, xs1) = xs in xs := xs1; x
end // end of [list_vt_uncons]

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

implement
{a}(*tmp*)
list_vt_length(xs) = let
//
fun
loop
{i,j:nat} .<i>.
(
xs: !list_vt(a, i), j: int j
) :<> int (i+j) = let
in
//
case+ xs of
| list_vt_cons
    (_, xs) => loop(xs, j + 1)
| list_vt_nil () => j
//
end // end of [loop]
//
prval() = lemma_list_vt_param(xs)
//
in
  loop(xs, 0)
end // end of [list_vt_length]

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

implement
{x}(*tmp*)
list_vt_copy(xs) = let
//
implement
{x2}(*tmp*)
list_vt_copylin$copy
  (x) = $UN.ptr0_get<x2>(addr@x)
//
in
  $effmask_all(list_vt_copylin<x>(xs))
end // end of [list_vt_copy]

implement
{x}(*tmp*)
list_vt_copylin
  (xs) = let
//
prval() = lemma_list_vt_param(xs)
//
fun
loop
{n:nat} .<n>.
(
  xs: !list_vt(x, n), res: &ptr? >> list_vt(x, n)
) : void = let
in
//
case+ xs of
| @list_vt_cons
    (x, xs1) => let
//
    val x =
    list_vt_copylin$copy<x>(x)
    val () =
    res := list_vt_cons{x}{0}(x, _)
    val+list_vt_cons(_, res1) = res
//
    val () = loop(xs1, res1)
//
    prval ((*folded*)) = fold@ (xs)
    prval ((*folded*)) = fold@ (res)
//
  in
    // nothing
  end // end of [list_vt_cons]
| list_vt_nil() => res := list_vt_nil()
//
end // end of [loop]
//
in
//
let
var res: ptr
val () = $effmask_all(loop(xs, res)) in res
end
//
end // end of [list_vt_copylin]

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

implement
{x}(*tmp*)
list_vt_copylin_fun
  (xs, f1) = let
//
implement
{x2}(*tmp*)
list_vt_copylin$copy
  (x) = x2 where
{
//
val f2 =
$UN.cast{(&RD(x2))->x2}(f1)
//
val x2 = $effmask_all(f2(x))
//
} (* end of [copy] *)
//
in
  list_vt_copylin<x>(xs)
end // end of [list_vt_copylin_fun]

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

implement
{a}(*tmp*)
list_vt_getref_at
  {n}{i} (xs, i) = let
//
fun
loop {
  n,i:nat | i <= n
} .<i>. (
  xs: &list_vt(a, n), i: int i
) :<> Ptr1 = let
in
//
if
(i > 0)
then res where
{
  val+
  @list_vt_cons(_, xs1) = xs
  val res =
  loop{n-1,i-1}(xs1, pred(i))
  prval ((*folded*)) = fold@ (xs)
} (* end of [then] *)
else $UN.cast2Ptr1(addr@(xs))
//
end // end of [loop]
//
in
//
$UN.ptr2cptr{list_vt(a,n-i)}(loop(xs, i))
//
end // end of [list_vt_getref_at]

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

implement
{a}(*tmp*)
list_vt_get_at
  {n} (xs, i) = x where
{
//
var xs = __ref (xs) where
{
  extern
  castfn __ref
    (xs: !list_vt(a, n)):<> list_vt(a, n)
  // castfn
} // end of [val]
//
val pi =
list_vt_getref_at<a>(xs, i)
//
val+list_cons(x, _) =
  $UN.ptr1_get<List1(a)>(cptr2ptr(pi))
//
prval() =
__unref(xs) where
{
  extern
  praxi __unref(xs: list_vt(a, n)): void
} // end of [prval]
//
} // end of [list_vt_get_at]

implement
{a}(*tmp*)
list_vt_set_at
  {n}(xs, i, x0) = let
//
var xs =
__ref(xs) where
{
  extern
  castfn __ref
    (xs: !list_vt(a, n)):<> list_vt(a, n)
  // end of [__ref]
} (* end of [val] *)
//
val pi =
list_vt_getref_at<a>(xs, i)
val
(pf, fpf | pi) = $UN.cptr_vtake(pi)
//
val+@list_vt_cons(x1, xs1) = !pi
//
val () = x1 := x0
//
prval() = fold@(!pi); prval() = fpf(pf)
//
prval() = let
  extern
  praxi __unref (xs: list_vt(a, n)): void
in
  __unref(xs)
end // end of [prval]
//
in
  // nothing
end // end of [list_vt_set_at]

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

implement
{a}(*tmp*)
list_vt_exch_at
  {n}(xs, i, x0) = let
//
var xs =
__ref(xs) where
{
  extern
  castfn __ref
    (xs: !list_vt(a, n)):<> list_vt(a, n)
} // end of [val]
//
val pi =
list_vt_getref_at<a>(xs, i)
val
(pf, fpf | pi) = $UN.cptr_vtake(pi)
val+@list_vt_cons(x1, xs1) = !pi
//
val t = x1
val () = x1 := x0
val () = x0 := t
prval() = fold@(!pi); prval() = fpf(pf)
//
prval() =
__unref(xs) where
{
  extern
  praxi __unref (xs: list_vt(a, n)): void
} // end of [prval]
//
in
  // nothing
end // end of [list_vt_exch_at]

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

implement
{a}(*tmp*)
list_vt_insert_at
  {n} (xs, i, x) = let
//
val pi =
list_vt_getref_at<a>(xs, i)
val xs_i = $UN.cptr_get(pi)
val xs1_i = list_vt_cons(x, xs_i)
val () =
  $UN.ptr1_set<List1_vt(a)>(cptr2ptr(pi), xs1_i)
//
prval() =
__assert(xs) where
{
  extern
  praxi
  __assert(xs: &list_vt(a, n) >> list_vt(a, n+1)): void
} // end of [prval]
in
  // nothing
end // end of [list_vt_insert_at]

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

implement
{a}(*tmp*)
list_vt_takeout_at
{n} (xs, i) = x1 where
{
//
val pi =
list_vt_getref_at<a>(xs, i)
val xs_i = $UN.cptr_get(pi)
val+~list_vt_cons(x1, xs1_i) = xs_i
val () =
  $UN.ptr1_set<List0_vt(a)> (cptr2ptr(pi), xs1_i)
//
prval() =
__assert(xs) where
{
  extern
  praxi
  __assert(xs: &list_vt(a, n) >> list_vt(a, n-1)): void
} (* end of [prval] *)
//
} // end of [list_vt_takeout_at]

(* ****** ****** *)
//
implement
{a}(*tmp*)
list_vt_copy(xs) =
  list_copy<a>($UN.list_vt2t(xs))
//
(* ****** ****** *)

implement
{a}(*tmp*)
list_vt_free(xs) = let
//
implement
(a2:t0p)
list_vt_freelin$clear<a2>
  (x) = let
  prval () = topize(x) in (*void*)
end // end of [list_vt_freelin$clear]
//
in
  list_vt_freelin<a>(xs)
end // end of [list_vt_free]

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

implement
{a}(*tmp*)
list_vt_freelin$clear
  (x) = gclear_ref<a>(x)
implement
{a}(*tmp*)
list_vt_freelin(xs) = let
//
prval() = lemma_list_vt_param(xs)
//
fun
loop
{n:nat} .<n>.
(
xs: list_vt(a, n)
) :<!wrt> void =
(
  case+ xs of
  | ~list_vt_nil
      () => ((*void*))
    // list_vt_nil
  | @list_vt_cons
      (x, xs1) => let
      val () =
        list_vt_freelin$clear<a>(x)
      val xs1 = xs1
      val ((*freed*)) = free@{a}{0}(xs)
    in
      loop(xs1)
    end // end of [list_vt_cons]
) (* end of [loop] *)
//
in
  loop(xs)
end // end of [list_vt_freelin]

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

implement
{a}(*tmp*)
list_vt_freelin_fun
  (xs, f1) = let
//
implement
{a2}(*tmp*)
list_vt_freelin$clear
  (x) = () where
{
//
val f2 =
  $UN.cast{(&a2 >> _?) -> void}(f1)
//
val ((*void*)) = $effmask_all(f2(x))
//
} (* end of [clear] *)
//
in
  list_vt_freelin<a>(xs)
end // end of [list_vt_freelin_fun]

(* ****** ****** *)
//
implement
{a}(*tmp*)
list_vt_uninitize
  {n}(xs) = let
//
prval() = lemma_list_vt_param(xs)
//
fun
loop
{n:nat} .<n>.
(
xs: !list_vt(a, n) >> list_vt(a?, n)
) :<!wrt> void =
(
  case+ xs of
  | @list_vt_nil
      () => fold@{a?}(xs)
    // end of [list_vt_nil]
  | @list_vt_cons
      (x, xs1) => let
      val () =
        list_vt_uninitize$clear(x)
      val () = loop(xs1)
      prval ((*folded*)) = fold@{a?}(xs)
    in
      // nothing
    end // end of [list_vt_cons]
) (* end of [loop] *)
//
in
  loop(xs)
end // end of [list_vt_uninitize]
//
implement
{a}(*tmp*)
list_vt_uninitize$clear(x) = gclear_ref<a>(x)
//
(* ****** ****** *)

implement
{a}(*tmp*)
list_vt_append
  {m,n}(xs, ys) = let
//
prval() =
lemma_list_vt_param(xs)
prval() =
lemma_list_vt_param(ys)
//
fun
loop
{m:nat} .<m>.
(
xs: &list_vt(a, m) >> list_vt(a, m+n), ys: list_vt(a, n)
) :<!wrt> void = let
in
//
case+ xs of
| ~list_vt_nil
    () => (xs := ys)
  // end of [list_vt_nil]
| @list_vt_cons
    (x, xs1) => let
    val () = loop(xs1, ys); prval() = fold@(xs) in (*none*)
  end // end of [list_vt_cons]
//
end (* end of [loop] *)
//
var res = xs
//
in
  let val () = loop(res, ys) in res end
end // end of [list_vt_append]

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

implement
{a}(*tmp*)
list_vt_extend
  (xs, y) =
  list_vt_append<a>(xs, cons_vt{a}(y, nil_vt()))
// end of [list_vt_extend]

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

implement
{a}(*tmp*)
list_vt_unextend
  (xs) = let
//
fun loop
  {n:pos} .<n>.
(
xs: &list_vt(a, n) >> list_vt(a, n-1)
) :<!wrt> (a) = let
//
val+@list_vt_cons(x, xs1) = xs
//
in
//
case+ xs1 of
| list_vt_nil() => let
    val x = x
    val xs1 = xs1
    val () = free@{a}{0}(xs)
  in
    xs := xs1; x
  end // end of [list_vt_nil]
| list_vt_cons _ => let
    val x = loop(xs1)
    prval() = fold@ (xs) in (x)
  end // end of [list_vt_cons]
//
end // end of [loop]
//
in
  loop(xs)
end // end of [list_vt_unextend]

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

implement
{a}(*tmp*)
list_vt_reverse (xs) =
list_vt_reverse_append<a>(xs, list_vt_nil(*void*))

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

implement
{a}(*tmp*)
list_vt_reverse_append
  (xs, ys) = let
//
prval() = lemma_list_vt_param(xs)
prval() = lemma_list_vt_param(ys)
//
fun
loop
{m,n:nat} .<m>.
(
xs: list_vt(a, m), ys: list_vt(a, n)
) :<!wrt> list_vt(a, m+n) =
(
  case+ xs of
  | ~list_vt_nil
      () => ys
    // list_vt_nil
  | @list_vt_cons
      (_, xs1) => let
      val xs1_ = xs1
      val () = xs1 := ys; prval() = fold@ (xs)
    in
      loop(xs1_, xs)
    end // end of [cons]
) (* end of [loop] *)
//
in
  loop(xs, ys)
end // end of [list_vt_reverse_append]

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

implement
{x}(*tmp*)
list_vt_split_at
  (xs, i) = let
//
fun loop
  {n:int}
  {i:nat | i <= n} .<n>.
(
xs: &list_vt(x, n) >> list_vt(x, i), i: int i
) :<!wrt> list_vt(x, n-i) =
(
if i > 0 then let
//
val+@cons_vt(x, xs1) = xs
//
val res = loop(xs1, i-1)
prval ((*folded*)) = fold@ (xs)
//
in
  res
end else let
  val res = xs
  val () = xs := list_vt_nil((*void*))
in
  res
end // end of [if]
) // end of [loop]
//
var xs = xs
val res = loop(xs, i)
//
in
  (xs, res)
end // end of [list_split_vt_at]

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

implement
{a}(*tmp*)
list_vt_concat
  (xss) = let
//
viewtypedef VT = List_vt(a)
viewtypedef VT0 = List0_vt(a)
//
fun loop
  {n:nat} .<n>.
(
  res: VT, xss: list_vt(VT, n)
) :<!wrt> VT0 = let
in
  case+ xss of
  | ~list_vt_cons
      (xs, xss) => let
      val res = list_vt_append<a>(xs, res)
    in
      loop(res, xss)
    end // end of [list_vt_cons]
  | ~list_vt_nil () => let
      prval() = lemma_list_vt_param(res) in res
    end // end of [list_vt_nil]
end (* end of [loop] *)
//
val xss = list_vt_reverse (xss)
//
prval() = lemma_list_vt_param(xss)
//
in
//
case+ xss of
| ~list_vt_cons
    (xs, xss) => loop(xs, xss)
| ~list_vt_nil() => list_vt_nil()
//
end // end of [list_vt_concat]

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

implement
{a}(*tmp*)
list_vt_filter(xs) = let
//
implement
list_vt_filterlin$pred<a>
  (x) = list_vt_filter$pred<a>(x)
implement
list_vt_filterlin$clear<a>
  (x) = let
  prval () = topize (x) in (*void*)
end // end of [list_vt_filterlin$clear]
//
in
  list_vt_filterlin<a>(xs)
end // end of [list_vt_filter]

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

implement
{a}(*tmp*)
list_vt_filterlin(xs) = let
//
prval() = lemma_list_vt_param(xs)
//
fun
loop
{n:nat} .<n>.
(
xs: &list_vt(a, n) >> listLte_vt(a, n)
) :<!wrt> void = let
in
//
case+ xs of
| @list_vt_nil
    () => fold@ (xs)
  // list_vt_nil
| @list_vt_cons
    (x, xs1) => let
    val test =
      list_vt_filterlin$pred<a>(x)
    // end of [val]
  in
    if test then let
      val () = loop(xs1)
    in
      fold@ (xs)
    end else let
      val xs1 = xs1
      val () =
        list_vt_filterlin$clear<a>(x)
      val ((*freed*)) = free@{a}{0}(xs)
    in
      let val () = xs := xs1 in loop(xs) end
    end // end of [if]
  end // end of [list_vt_cons]
//
end // end of [loop]
//
in
  let var xs = xs in loop(xs); xs end
end // end of [list_vt_filterlin]

(* ****** ****** *)
//
implement
{a}(*tmp*)
list_vt_filterlin$clear(x) = gclear_ref<a>(x)

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

implement
{a}(*tmp*)
list_vt_separate
  (xs, n1) = res2 where
{
//
prval() = lemma_list_vt_param(xs)
//
fun
loop
{k,n:nat} .<n>.
(
  xs: list_vt(a, n)
, n1: &int(k) >> int(n1+k)
, res1: &ptr? >> list_vt(a, n1)
, res2: &ptr? >> list_vt(a, n2)
) : #[n1,n2:nat | n1+n2==n] void =
(
//
case+ xs of
| ~list_vt_nil() =>
  (
    res1 := list_vt_nil();
    res2 := list_vt_nil();
  ) (* end of [list_vt_nil] *)
| @list_vt_cons
    (x, xs_tl) => let
    val xs_tl_ = xs_tl
    val test =
      list_vt_separate$pred<a>(x)
    // end of [val]
  in
    if test
      then let
      val () = n1 := n1+1
      val () = res1 := xs
      val () = loop(xs_tl_, n1, xs_tl, res2)
    in
      fold@(res1)
    end else let
      val () = res2 := xs
      val () = loop(xs_tl_, n1, res1, xs_tl)
    in
      fold@(res2)
    end // end of [if]
  end // end of [list_vt_cons]
//
) (* end of [loop] *)
//
var res1: ptr
var res2: ptr
//
val () = n1 := 0
val () = loop(xs, n1, res1, res2)
val () = xs := res1
//
} (* end of [list_vt_separate] *)

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

implement
{a}(*tmp*)
list_vt_take_until
  (xs, n1) = res1 where
{
//
prval() = lemma_list_vt_param(xs)
//
fun
loop
{k,n:nat} .<n>.
(
  xs: list_vt(a, n)
, n1: &int(k) >> int(n1+k)
, res1: &ptr? >> list_vt(a, n1)
, res2: &ptr? >> list_vt(a, n2)
) : #[n1,n2:nat | n1+n2==n] void =
(
//
case+ xs of
| ~list_vt_nil() =>
  (
    res1 := list_vt_nil();
    res2 := list_vt_nil();
  ) (* end of [list_vt_nil] *)
| @list_vt_cons
    (x, xs_tl) => let
    val test =
      list_vt_take_until$pred<a>(x)
    // end of [val]
  in
    if test
      then let
      val () =
      res1 := list_vt_nil
      val () = res2 := xs
    in
      fold@(res2) // folded
    end else let
      val xs_tl_ = xs_tl
      val () = n1 := n1+1
      val () = res1 := xs
      val () = loop(xs_tl_, n1, xs_tl, res2)
    in
      fold@(res1) // folded
    end // end of [if]
  end // end of [list_vt_cons]
//
) (* end of [loop] *)
//
var res1: ptr
var res2: ptr
//
val () = n1 := 0
val () = loop(xs, n1, res1, res2)
val () = xs := res2
//
} (* end of [list_vt_take_until] *)

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

implement
{a}(*tmp*)
list_vt_app
  (xs) = let
in
//
case+ xs of
| @list_vt_cons
    (x, xs1) => let
    val () =
      list_vt_app$fwork<a>(x)
    val () = list_vt_app<a>(xs1)
    prval ((*folded*)) = fold@ (xs)
  in
    // nothing
  end // end of [cons]
| list_vt_nil((*void*)) => ()
//
end // end of [list_vt_app]

implement
{a}(*tmp*)
list_vt_appfree
  (xs) = let
in
//
case+ xs of
| @list_vt_cons
    (x, xs1) => let
    val xs1 = xs1
    val () =
    list_vt_appfree$fwork<a>(x)
    val ((*freed*)) = free@{a}{0}(xs)
  in
    list_vt_appfree<a>(xs1)
  end // end of [cons]
| ~list_vt_nil((*void*)) => ()
//
end // end of [list_vt_appfree]

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

implement
{a}{b}
list_vt_map
  (xs) = let
//
prval() =
lemma_list_vt_param(xs)
//
fun
loop
{n:nat} .<n>.
(
  xs: !list_vt(a, n)
, res: &ptr? >> list_vt(b, n)
) : void = let
in
  case+ xs of
  | list_vt_nil() =>
      (res := list_vt_nil())
    // end of [list_vt_nil]
  | @list_vt_cons
      (x, xs1) => let
      val y =
      list_vt_map$fopr<a><b>(x)
      // end of [val]
      val () =
      res := list_vt_cons{b}{0}(y, _)
      val+list_vt_cons(_, res1) = res
      val () = loop(xs1, res1)
      prval ((*folded*)) = fold@ (xs)
      prval ((*folded*)) = fold@ (res)
    in
      // nothing
    end // end of [list_vt_cons]
end // end of [loop]
//
in
  let var res: ptr in loop(xs, res); res end
end // end of [list_vt_map]

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

implement
{x}{y}(*tmp*)
list_vt_map_fun
  (xs, f0) = let
//
implement
{x2}{y2}
list_vt_map$fopr(x2) = let
//
val f0 =
$UN.cast{(&x2)->y}(f0) in $UN.castvwtp0{y2}(f0(x2))
//
end // end of [list_vt_map$fopr]
//
in
  list_vt_map<x><y>(xs)
end // end of [list_vt_map_fun]

implement
{x}{y}(*tmp*)
list_vt_map_clo
  (xs, f0) = let
//
val f0 =
$UN.cast{(&x) -<cloref1> y}(addr@f0)
//
implement
{x2}{y2}
list_vt_map$fopr(x2) = let
//
val f0 =
$UN.cast{(&x2)-<cloref1>y}(f0) in $UN.castvwtp0{y2}(f0(x2))
//
end // end of [list_vt_map$fopr]
//
in
  list_vt_map<x><y>(xs)
end // end of [list_vt_map_clo]

implement
{x}{y}(*tmp*)
list_vt_map_cloref
  (xs, f0) = let
//
implement
{x2}{y2}
list_vt_map$fopr(x2) = let
//
val f0 =
$UN.cast{(&x2)-<cloref1>y}(f0) in $UN.castvwtp0{y2}(f0(x2))
//
end // end of [list_vt_map$fopr]
//
in
  list_vt_map<x><y>(xs)
end // end of [list_vt_map_cloref]

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

implement
{a}{b}
list_vt_mapfree
  (xs) = let
//
prval() =
lemma_list_vt_param(xs)
//
fun
loop
{n:nat} .<n>.
(
  xs: list_vt(a, n)
, res: &ptr? >> list_vt(b, n)
) : void = let
in
  case+ xs of
  | @list_vt_cons
      (x, xs1) => let
      val y =
      list_vt_mapfree$fopr<a><b>(x)
      val xs1_val = xs1
      val ((*freed*)) = free@{a}{0}(xs)
      val () =
      res := list_vt_cons{b}{0}(y, _)
      val+list_vt_cons(_, res1) = res
      val () = loop(xs1_val, res1)
      prval ((*folded*)) = fold@(res)
    in
      // nothing
    end // end of [list_vt_cons]
  | ~list_vt_nil() => (res := list_vt_nil())
end // end of [loop]
//
in
  let var res: ptr in loop(xs, res); res end
end // end of [list_vt_mapfree]

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

implement
{x}{y}(*tmp*)
list_vt_mapfree_fun
  (xs, f0) = let
//
implement
{x2}{y2}
list_vt_mapfree$fopr
  (x2) = let
//
val f0 =
$UN.cast{(&x2>>_?)->y}(f0) in $UN.castvwtp0{y2}(f0(x2))
//
end // end of [list_vt_mapfree$fopr]
//
in
  list_vt_mapfree<x><y>(xs)
end // end of [list_vt_mapfree_fun]

implement
{x}{y}(*tmp*)
list_vt_mapfree_clo
  (xs, f0) = let
//
val f0 =
$UN.cast{(&x>>_?) -<cloref1> y}(addr@f0)
//
implement
{x2}{y2}
list_vt_mapfree$fopr(x2) = let
//
val f0 =
$UN.cast{(&x2>>_?)-<cloref1>y}(f0) in $UN.castvwtp0{y2}(f0(x2))
//
end // end of [list_vt_mapfree$fopr]
//
in
  list_vt_mapfree<x><y>(xs)
end // end of [list_vt_mapfree_clo]

implement
{x}{y}(*tmp*)
list_vt_mapfree_cloref
  (xs, f0) = let
//
implement
{x2}{y2}
list_vt_mapfree$fopr(x2) = let
//
val f0 =
$UN.cast{(&x2>>_?)-<cloref1>y}(f0) in $UN.castvwtp0{y2}(f0(x2))
//
end // end of [list_vt_mapfree$fopr]
//
in
  list_vt_mapfree<x><y>(xs)
end // end of [list_vt_mapfree_cloref]

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

implement
{x}(*tmp*)
list_vt_foreach
  (xs) = let
  var env: void = ()
in
  list_vt_foreach_env<x><void> (xs, env)
end // end of [list_vt_foreach]

implement
{x}{env}
list_vt_foreach_env
  (xs, env) = let
//
prval() =
lemma_list_vt_param(xs)
//
fun loop
  {n:nat} .<n>.
(
  xs: !list_vt(x, n), env: &env
) : void = let
in
//
case+ xs of
| @list_vt_cons
    (x, xs1) => let
    val test =
      list_vt_foreach$cont<x><env>(x, env)
    // end of [val]
  in
    if test then let
      val () =
        list_vt_foreach$fwork<x><env>(x, env)
      val () = loop(xs1, env)
      prval ((*void*)) = fold@ (xs)
    in
      // nothing
    end else let
      prval ((*void*)) = fold@ (xs) in (*nothing*)
    end // end of [if]
  end // end of [cons]
| list_vt_nil((*void*)) => ()
//
end // end of [loop]
//
in
  loop(xs, env)
end // end of [list_vt_foreach_env]

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

implement
{x}{env}
list_vt_foreach$cont(x, env) = true

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

implement
{a}(*tmp*)
list_vt_foreach_fun
  {fe}(xs, f0) = let
//
prval() = lemma_list_vt_param(xs)
//
fun
loop
{n:nat} .<n>.
(
xs: !list_vt(a, n), f0: (&a) -<fe> void
) :<fe> void =
  case+ xs of
  | @list_vt_cons
      (x, xs1) => let
      val () = f0(x)
      val () = loop(xs1, f0)
    in
      fold@ (xs)
    end // end of [cons]
  | list_vt_nil((*void*)) => ()
// end of [loop]
in
  loop(xs, f0)
end // end of [list_vt_foreach_fun]

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

implement
{a}(*tmp*)
list_vt_foreach_cloref
  {fe}(xs, f0) = let
//
prval() = lemma_list_vt_param(xs)
//
fun
loop
{n:nat} .<n>.
(
xs: !list_vt(a, n), f0: (&a) -<cloref,fe> void
) :<fe> void =
  case+ xs of
  | @list_vt_cons
      (x, xs1) => let
      val () = f0(x)
      val () = loop(xs1, f0)
    in
      fold@ (xs)
    end // end of [cons]
  | list_vt_nil ((*void*)) => ()
// end of [loop]
in
  loop(xs, f0)
end // end of [list_vt_foreach_cloref]

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

implement
{a}(*tmp*)
list_vt_foreach_funenv
  {v}{vt}{fe}
  (pf | xs, f0, env) = let
//
prval() =
lemma_list_vt_param(xs)
//
fun
loop
{n:nat} .<n>.
(
  pf: !v
| xs: !list_vt(a, n)
, f0: (!v | &a, !vt) -<fe> void
, env: !vt
) :<fe> void =
  case+ xs of
  | @list_vt_cons
      (x, xs1) => let
      val () = f0 (pf | x, env)
      val () = loop(pf | xs1, f0, env)
    in
      fold@ (xs)
    end // end of [cons]
  | list_vt_nil ((*void*)) => ()
// end of [loop]
//
in
  loop(pf | xs, f0, env)
end // end of [list_vt_foreach_funenv]

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

implement
{x}(*tmp*)
list_vt_iforeach
  (xs) = let
  var env: void = ()
in
  list_vt_iforeach_env<x><void> (xs, env)
end // end of [list_vt_iforeach]

implement
{x}{env}
list_vt_iforeach_env
  (xs, env) = let
//
prval() =
lemma_list_vt_param(xs)
//
fun
loop
{n:nat}{i:nat} .<n>.
(
  i: int i, xs: !list_vt(x, n), env: &env
) : intBtwe(i, n+i) = let
in
  case+ xs of
  | @list_vt_cons
      (x, xs1) => let
      val test =
      list_vt_iforeach$cont<x><env>
        (i, x, env)
      // end of [val]
    in
      if test then let
        val () =
        list_vt_iforeach$fwork<x><env>
          (i, x, env)
        // end of [val]
        val i = loop(succ(i), xs1, env)
        prval ((*folded*)) = fold@ (xs)
      in
        i // the number of processed elements
      end else let
        prval ((*folded*)) = fold@ (xs)
      in
        i // the number of processed elements
      end // end of [if]
    end // end of [cons]
  | list_vt_nil ((*void*)) => (i) // |processed-elements|
end // end of [loop]
//
in
  loop(0, xs, env)
end // end of [list_vt_iforeach_env]

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

implement
{x}{env}
list_vt_iforeach$cont(i, x, env) = true

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

#include "./SHARE/list_vt_mergesort.dats"
#include "./SHARE/list_vt_quicksort.dats"

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

implement
{a}(*tmp*)
streamize_list_vt_elt
  (xs) = let
//
fun
auxmain
(
xs: List_vt(a)
) : stream_vt(a) = $ldelay
(
//
(
case+ xs of
| ~list_vt_nil
    () => stream_vt_nil()
| ~list_vt_cons
    (x, xs) =>
    stream_vt_cons(x, auxmain(xs))
) : stream_vt_con(a)
//
,
//
list_vt_freelin<a>(xs)
) (* end of [auxmain] *)
//
in
  $effmask_all(auxmain(xs))
end (* end of [streamize_list_vt_elt] *)

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

implement
{tk}(*tmp*)
listize_g0int_rep
  (i0, base) = let
//
fun
loop{i:int}
(
i0: g1int(tk, i), res: List0_vt(int)
) : List0_vt(int) =
(
if
isgtz(i0)
then
loop
( ndiv_g1int_int1(i0, base)
, list_vt_cons(nmod_g1int_int1(i0, base), res)
) (* end of [then] *)
else res // end-of-else
)
//
in
//
$UN.castvwtp0
(
$effmask_all(loop(g1ofg0_int(i0), list_vt_nil(*void*)))
) (* $UN.castvwtp0 *)
//
end // end of [listize_g0int_rep]

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

implement
{a}(*tmp*)
list_vt_permute
  {n}(xs) = xs where
{
//
prval() =
lemma_list_vt_param(xs)
//
fun
loop1
{n:nat} .<n>.
(
p0: ptr, xs: !list_vt(a, n)
) : void =
(
case+ xs of
| list_vt_nil
    () => ((*void*))
  // list_vt_nil
| list_vt_cons
    (_, xs_tl) => let
    val () =
    $UN.ptr0_set<ptr>
      (p0, $UN.castvwtp1{ptr}(xs))
    // end of [val]
  in
    loop1(ptr_succ<ptr>(p0), xs_tl)
  end // end of [loop1]
)
//
val n0 =
  i2sz(list_vt_length<a>(xs))
//
val A0 =
  arrayptr_make_uninitized<ptr>(n0)
val () = loop1(ptrcast(A0), xs)
val xs = $UN.castvwtp0{ptr}(xs)
val A0 = $UN.castvwtp0{arrayptr(ptr,n)}(A0)
//
local
//
implement
array_permute$randint<>(n) =
i2sz(list_vt_permute$randint<>(sz2i(n)))
//
in (* in-of-local *)
//
val
(pf | p0) =
arrayptr_takeout_viewptr{ptr}(A0)
//
val
((*void*)) = array_permute<ptr>(!p0, n0)
//
prval
((*void*)) = arrayptr_addback{ptr}(pf | A0)
//
end // end of [local]
//
fun
loop2
{i:nat|i <= n} .<i>.
(
pz: ptr, i0: size_t(i), res: list_vt(a, n-i)
) : list_vt(a, n) =
(
//
if
(i0 > 0)
then let
//
val pz = ptr_pred<ptr>(pz)
val xs =
$UN.ptr0_get<
  list_vt_cons_pstruct(a,ptr?)>(pz)
//
val+
list_vt_cons(_, xs_tl) = xs
//
val () = (xs_tl := res)
prval((*folded*)) = fold@(xs)
//
in
  loop2(pz, pred(i0), xs(*res*))
end // end of [then]
else res // end of [else]
//
) (* end of [loop2] *)
//
val pz = ptr_add<ptr>(ptrcast(A0), n0)
val xs = loop2(pz, n0, list_vt_nil(*void*))
//
val ((*freed*)) = arrayptr_free{ptr}(A0)
//
} (* end of [list_vt_permute] *)

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

(* end of [list_vt.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/option.atxt
** Time of generation: Fri Aug 18 03:30:02 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: Feburary, 2012 *)

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

implement{a} option_some (x) = Some (x)
implement{a} option_none ( ) = None ( )

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

implement
{}(*tmp*)
option2bool(opt) =
  case+ opt of Some _ => true | None _ => false
// end of [option2bool]

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

implement
{}(*tmp*)
option_is_some (opt) =
  case+ opt of Some _ => true | None _ => false
// end of [option_is_some]

implement
{}(*tmp*)
option_is_none (opt) =
  case+ opt of Some _ => false | None _ => true
// end of [option_is_none]

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

implement
{a}(*tmp*)
option_unsome
  (opt) = x where { val+Some (x) = opt }
// end of [option_unsome]

implement
{a}(*tmp*)
option_unsome_exn
  (opt) = (
  case+ opt of
  | Some x => x | None _ => $raise NotSomeExn()
) // end of [option_unsome_exn]

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

implement
{a}(*tmp*)
option_equal
  (opt1, opt2) =
(
//
case+ opt1 of
| None () =>
  (
    case+ opt1 of None () => true | Some _ => false
  ) (* end of [None] *)
| Some x1 =>
  (
    case+ opt2 of
    | None () => false | Some x2 => option_equal$eqfn(x1, x2)
  ) (* end of [Some] *)
//
) (* end of [option_equal] *)

(* ****** ****** *)
//
implement
{a}(*tmp*)
print_option(opt) =
  fprint_option<a>(stdout_ref, opt)
implement
{a}(*tmp*)
prerr_option(opt) =
  fprint_option<a>(stderr_ref, opt)
//
implement
{a}(*tmp*)
fprint_option
  (out, opt) = let
in
//
case+ opt of
| Some x => {
    val () =
      fprint_string(out, "Some(")
    // end of [val]
    val () = fprint_val<a> (out, x)
    val () = fprint_string (out, ")")
  } (* end of [Some] *)
| None _ => fprint_string(out, "None()")
//
end // end of [fprint_option]
//
(* ****** ****** *)

(* end of [option.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/option_vt.atxt
** Time of generation: Fri Aug 18 03:30:02 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: Feburary, 2012 *)

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

implement{a} option_vt_some (x) = Some_vt (x)
implement{a} option_vt_none ( ) = None_vt ( )

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

implement
{a}(*tmp*)
option_vt_make_opt
  (b, x) = (
  if b then let
    prval () = opt_unsome{a}(x) in Some_vt{a}(x)
  end else let
    prval () = opt_unnone{a}(x) in None_vt{a}( )
  end // end of [if]
) (* end of [option_vt_make_opt] *)

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

implement
{}(*tmp*)
option_vt_is_some
  (opt) = case+ opt of
  | Some_vt _ => true | None_vt _ => false
// end of [option_is_some]

implement{}
option_vt_is_none
  (opt) = case+ opt of
  | Some_vt _ => false | None_vt _ => true
// end of [option_is_none]

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

implement
{a}(*tmp*)
option_vt_unsome
  (opt) = x where { val+ ~Some_vt(x) = opt }
// end of [option_unsome]

implement
{a}(*tmp*)
option_vt_unnone
  (opt) = () where { val+ ~None_vt() = opt }
// end of [option_unnone]

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

implement
{a}(*tmp*)
option_vt_free(opt) =
(
case+ opt of ~Some_vt _ => () | ~None_vt _ => ()
) // end of [option_vt_free]

implement
{a}(*tmp*)
option2bool_vt(opt) =
(
case+ opt of ~Some_vt _ => true | ~None_vt _ => false
) // end of [option2bool_vt]

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

implement
{a}(*tmp*)
fprint_option_vt
  (out, opt) = let
in
//
case+ opt of
| @Some_vt (x) => {
    val (
    ) = fprint_string (out, "Some_vt(")
    val () = fprint_ref<a> (out, x)
    val () = fprint_string (out, ")")
    prval () = fold@ (opt)
  } (* end of [Some_vt] *)
| None_vt () => {
    val () = fprint_string (out, "None_vt()")
  } (* end of [None_vt] *)
//
end // end of [fprint_option_vt]

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

(* end of [option_vt.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(* Author: Hongwei Xi *)
(* Start time: July, 2012 *)
(* Authoremail: gmhwxiATgmailDOTcom *)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/list.atxt
** Time of generation: Fri Aug 25 22:54:43 2017
*)

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

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

(* ****** ****** *)
//
implement
{a}(*tmp*)
stream_is_nil(xs) =
(
case+ !xs of
| stream_nil _ => true | stream_cons _ => false
)
implement
{a}(*tmp*)
stream_is_cons(xs) = not(stream_is_nil<a>(xs))
//
(* ****** ****** *)
//
implement
{a}(*tmp*)
stream_make_nil() =
  $delay(stream_nil{a}())
//
implement
{a}(*tmp*)
stream_make_cons
  (x, xs) = $delay(stream_cons{a}(x, xs))
//
(* ****** ****** *)
//
implement
{a}(*tmp*)
stream_sing(x) =
  stream_cons{a}(x, $delay(stream_nil))
//
implement
{a}(*tmp*)
stream_make_sing(x) =
  $delay(stream_cons{a}(x, $delay(stream_nil)))
//
(* ****** ****** *)

implement
{a}(*tmp*)
stream2list (xs) = let
//
fun loop
(
  xs: stream(a)
, res: &ptr? >> List0_vt(a)
) : void = let
in
  case+ !xs of
  | stream_cons
      (x, xs) => let
      val () =
      res := list_vt_cons{a}{0}(x, _)
      val+list_vt_cons (_, res1) = res
      val ((*void*)) = loop (xs, res1)
    in
      fold@ (res)
    end // end of [stream_cons]
  | stream_nil() => res := list_vt_nil(*void*)
end // end of [loop]
var res: ptr // uninitialized
val () = $effmask_all (loop (xs, res))
//
in
  res
end // end of [stream2list]

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

implement
{a}(*tmp*)
stream_length
  (xs) = loop(xs, 0) where
{
//
fun
loop
(
  xs: stream(a), j: intGte(0)
) :<!laz> intGte(0) =
(
case+ !xs of
| stream_nil() => j
| stream_cons(_, xs) => loop(xs, j+1)
)
//
} (* end of [stream_length] *)

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

implement
{a}(*tmp*)
stream_head_exn(xs) =
(
//
case+ !xs of
| stream_cons
    (x, _) => x
  // stream_cons
| stream_nil() => $raise StreamSubscriptExn()
//
) // end of [stream_head_exn]

implement
{a}(*tmp*)
stream_tail_exn(xs) =
(
//
case+ !xs of
| stream_cons
    (_, xs) => xs
  // stream_cons
| stream_nil() => $raise StreamSubscriptExn()
//
) // end of [stream_tail_exn]

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

implement
{a}(*tmp*)
stream_nth_exn
  (xs, n) = let
in
  case+ !xs of
  | stream_cons
      (x, xs) =>
    (
      if n > 0
        then stream_nth_exn<a>(xs, pred(n))
        else (x)
      // end of [if]
    ) (* stream_cons *)
  | stream_nil() => $raise StreamSubscriptExn()
end // end of [stream_nth_exn]

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

implement
{a}(*tmp*)
stream_nth_opt
  (xs, n) = let
in
//
try
Some_vt(stream_nth_exn<a>(xs, n)) with ~StreamSubscriptExn() => None_vt()
//
end // end of [stream_nth_opt]

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

implement
{a}(*tmp*)
stream_get_at_exn(xs, n) = stream_nth_exn<a>(xs, n)

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

implement
{a}(*tmp*)
stream_takeLte
  (xs, n) = let
//
fun
auxmain
(
  xs: stream(a)
, n0: intGte(0)
) : stream_vt(a) = $ldelay
(
if
(n0 > 0)
then
(
case+ !xs of
| stream_nil() =>
    stream_vt_nil()
  // end of [stream_nil]
| stream_cons(x, xs) =>
    stream_vt_cons(x, auxmain(xs, n0-1))
  // end of [stream_cons]
)
else stream_vt_nil()
) (* end of [auxmain] *)
//
in
  auxmain(xs, n)
end // end of [stream_takeLte]

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

implement
{a}(*tmp*)
stream_take_exn
  (xs, n) = let
//
fun
loop{n:nat}
(
  xs: stream(a)
, res: &ptr? >> list_vt(a, n-k), n: int(n)
) : #[k:nat | k <= n] int k =
(
//
if
(n > 0)
then (
  case+ !xs of
  | stream_cons
      (x, xs) => k where
    {
      val () =
      res := list_vt_cons{a}{0}(x, _)
      val+list_vt_cons (_, res1) = res
      val k = loop (xs, res1, pred(n))
      prval () = fold@ (res)
    } (* end of [stream_cons] *)
  | stream_nil() => let
      val () =
        res := list_vt_nil() in n
      // end of [val]
    end // end of [stream_nil]
) else (
  let val () = res := list_vt_nil() in n end
) (* end of [if] *)
//
) (* end of [loop] *)
//
var res: ptr // uninitialized
val k = $effmask_all (loop (xs, res, n))
//
in
//
$effmask_all (
if k = 0 then res else let
  val () = list_vt_free (res) in $raise StreamSubscriptExn()
end // end of [if]
) // end of [$effmask_all]
//
end // end of [stream_take_exn]

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

implement
{a}(*tmp*)
stream_drop_exn
  (xs, n) = let
//
fun
aux:
$d2ctype
(
stream_drop_exn<a>
) =
lam(xs, n) => 
(
//
if n > 0 then
(
  case+ !xs of
  | stream_cons
      (_, xs) => aux(xs, pred(n))
    // stream_cons
  | stream_nil() => $raise StreamSubscriptExn()
) else (xs) // end of [if]
//
) (* end of [aux] *)
//
in
  aux(xs, n)
end // end of [stream_drop_exn]

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

implement
{a}(*tmp*)
stream_drop_opt
  (xs, n) = let
fun
aux:
$d2ctype
(
stream_drop_opt<a>
) =
lam(xs, n) =>
(
//
if n > 0 then
(
  case+ !xs of
  | stream_nil() => None_vt()
  | stream_cons(_, xs) => aux(xs, pred(n))
) else Some_vt(xs) // end of [if]
//
) (* end of [aux] *)
//
in
  aux(xs, n)
end // end of [stream_drop_opt]

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

implement
{a}(*tmp*)
stream_append
  (xs, ys) = let
//
fun aux
(
  xs: stream(a)
, ys: stream(a)
) : stream_con(a) =
  case+ !xs of
  | stream_nil() => !ys
  | stream_cons(x, xs) => stream_cons(x, $delay(aux(xs, ys)))
//
in
//
  $delay(aux(xs, ys))
//
end // end of [stream_append]

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

implement
{a}(*tmp*)
stream_concat
  (xss) = let
//
fun aux1
(
  xss: stream(stream(a))
) : stream_con(a) =
(
  case+ !xss of
  | stream_nil() => stream_nil()
  | stream_cons(xs, xss) => aux2(xs, xss)
)
and aux2
(
  xs: stream(a), xss: stream(stream(a))
) : stream_con(a) =
  case+ !xs of
  | stream_nil() => aux1 (xss)
  | stream_cons(x, xs) => stream_cons (x, $delay(aux2(xs, xss)))
//
in
  $delay(aux1(xss))
end // end of [stream_concat]

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

local

fun{a:t0p}
stream_filter_con
(
xs: stream(a)
) : stream_con(a) = let
in
//
case+ !xs of
| stream_cons
    (x, xs) =>
  (
    if stream_filter$pred<a>(x)
      then stream_cons{a}(x, stream_filter<a>(xs)) else stream_filter_con<a>(xs)
    // end of [if]
  ) // end of [stream_cons]
| stream_nil() => stream_nil()
//
end // end of [stream_filter_con]

in (* in of [local] *)

implement
{a}(*tmp*)
stream_filter (xs) =
  $delay(stream_filter_con<a>(xs))
// end of [stream_filter]

implement
{a}(*tmp*)
stream_filter_fun
  (xs, p) = let
//
implement{a2}
stream_filter$pred (x) = p($UN.cast{a}(x))
//
in
  stream_filter (xs)
end // end of [stream_filter_fun]

implement
{a}(*tmp*)
stream_filter_cloref (xs, p) = let
//
implement{a2}
stream_filter$pred (x) = p($UN.cast{a}(x))
//
in
  stream_filter (xs)
end // end of [stream_filter_cloref]

end // end of [local]

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

implement
{a}{b}
stream_map
  (xs) = let
//
fun aux
(
  xs: stream (a)
) :<!laz> stream (b) = $delay
(
case+ !xs of
| stream_nil() => stream_nil()
| stream_cons(x, xs) =>
    stream_cons{b}(stream_map$fopr<a><b>(x), aux(xs))
  // end of [stream_cons]
) : stream_con (b) // end of [$delay]
//
in
  aux (xs)
end // end of [stream_map]

implement
{a}{b}
stream_map_fun
  (xs, f) = let
//
implement
{a2}{b2}
stream_map$fopr (x) = $UN.cast{b2}(f($UN.cast{a}(x)))
//
in
  stream_map<a><b>(xs)
end // end of [stream_map_fun]

implement
{a}{b}
stream_map_cloref
  (xs, f) = let
//
implement
{a2}{b2}
stream_map$fopr (x) = $UN.cast{b2}(f($UN.cast{a}(x)))
//
in
  stream_map<a><b>(xs)
end // end of [stream_map_cloref]

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

implement
{a}{b}
stream_imap
  (xs) = let
//
fun aux
(
  i: intGte(0), xs: stream (a)
) :<!laz> stream (b) = $delay
(
case+ !xs of
| stream_nil() => stream_nil()
| stream_cons
    (x, xs) => let
    val y =
      stream_imap$fopr<a><b>(i, x)
    // end of [val]
  in
    stream_cons{b}(y, aux(succ(i), xs))
  end // end of [stream_cons]
) : stream_con (b) // end of [$delay]
//
in
  aux (0, xs)
end // end of [stream_imap]

implement
{a}{b}
stream_imap_fun
  (xs, f) = let
//
implement
{a2}{b2}
stream_imap$fopr
  (i, x) = $UN.cast{b2}(f(i, $UN.cast{a}(x)))
//
in
  stream_imap<a><b>(xs)
end // end of [stream_imap_fun]

implement
{a}{b}
stream_imap_cloref
  (xs, f) = let
//
implement
{a2}{b2}
stream_imap$fopr
  (i, x) = $UN.cast{b2}(f(i, $UN.cast{a}(x)))
//
in
  stream_imap<a><b>(xs)
end // end of [stream_imap_cloref]

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

local

#define :: stream_cons

in (* in of [local] *)

implement
{a1,a2}{b}
stream_map2
(
  xs1, xs2
) = $delay (
(
case+ !xs1 of
| x1 :: xs1 =>
  (
  case+ !xs2 of
  | x2 :: xs2 => let
      val y =
        stream_map2$fopr<a1,a2><b>(x1, x2)
      // end of [val]
    in
      stream_cons{b}(y, stream_map2<a1,a2><b>(xs1, xs2))
    end // end of [::]
  | stream_nil() => stream_nil()
  ) // end of [::]
| stream_nil() => stream_nil()
) : stream_con (b)
) // end of [stream_map2]

end // end of [local]

implement
{a1,a2}{b}
stream_map2_fun
  (xs1, xs2, f) = let
//
implement
{a12,a22}{b2}
stream_map2$fopr (x1, x2) =
  $UN.cast{b2}(f($UN.cast{a1}(x1), $UN.cast{a2}(x2)))
//
in
  stream_map2<a1,a2><b>(xs1, xs2)
end // end of [stream_map2_fun]

implement
{a1,a2}{b}
stream_map2_cloref
  (xs1, xs2, f) = let
//
implement
{a12,a22}{b2}
stream_map2$fopr (x1, x2) =
  $UN.cast{b2}(f($UN.cast{a1}(x1), $UN.cast{a2}(x2)))
//
in
  stream_map2<a1,a2><b>(xs1, xs2)
end // end of [stream_map2_cloref]

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

implement
{res}{x}
stream_scan
  (xs, ini) = let
//
fun
auxmain
(
  xs: stream(x), ini: res
) :<!laz> stream(res) = $delay
(
case+ !xs of
| stream_nil
    () => stream_nil()
  // end of [stream_nil]
| stream_cons
    (x, xs) =>
  stream_cons{res}
    (stream_scan$fopr<res><x>(ini, x), auxmain(xs, ini))
  // end of [stream_cons]
) // end of [$delay] // end of [auxmain]
//
in
  stream_make_cons<res>(ini, auxmain(xs, ini))
end // end of [stream_scan]

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

implement
{res}{x}
stream_scan_fun
  (xs, ini, f) = let
//
implement
{res2}{x2}
stream_scan$fopr
  (ini, x) =
  $UN.cast{res2}(f($UN.cast{res}(ini), $UN.cast{x}(x)))
//
in
  stream_scan<res><x>(xs, ini)
end // end of [stream_scan_fun]

implement
{res}{x}
stream_scan_cloref
  (xs, ini, f) = let
//
implement
{res2}{x2}
stream_scan$fopr
  (ini, x) =
  $UN.cast{res2}(f($UN.cast{res}(ini), $UN.cast{x}(x)))
//
in
  stream_scan<res><x>(xs, ini)
end // end of [stream_scan_cloref]

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

local

#define :: stream_cons

in (* in of [local] *)

implement
{a}(*tmp*)
stream_merge
  (xs10, xs20) = let
//
fun
auxmain:
$d2ctype
(
stream_merge<a>
) =
lam
(
xs10, xs20
) => $delay
(
case+ !xs10 of
| x1 :: xs1 =>
  (
  case+ !xs20 of
  | x2 :: xs2 => let
      val sgn =
        stream_merge$cmp<a>(x1, x2)
      // end of [val]
    in
      if sgn <= 0 then
        stream_cons{a}(x1, auxmain(xs1, xs20))
      else
        stream_cons{a}(x2, auxmain(xs10, xs2))
      // end of [if]
    end // end of [::]
  | stream_nil() => stream_cons{a}(x1, xs1)
  ) (* end of [::] *)
| stream_nil() => !xs20
) (* end of [auxmain] *)
//
in
  auxmain(xs10, xs20)
end // end of [stream_merge]

end // end of [local]

(* ****** ****** *)
//
implement
{a}(*tmp*)
stream_merge$cmp
  (x1, x2) = gcompare_val_val<a>(x1, x2)
//
(* ****** ****** *)

implement
{a}(*tmp*)
stream_merge_fun
  (xs1, xs2, cmp) = let
//
implement{a2}
stream_merge$cmp(x1, x2) =
  cmp($UN.cast{a}(x1), $UN.cast{a}(x2))
//
in
  stream_merge<a>(xs1, xs2)
end // end of [stream_merge_fun]

implement
{a}(*tmp*)
stream_merge_cloref
  (xs1, xs2, cmp) = let
//
implement{a2}
stream_merge$cmp(x1, x2) =
  cmp($UN.cast{a}(x1), $UN.cast{a}(x2))
//
in
  stream_merge<a>(xs1, xs2)
end // end of [stream_merge_cloref]

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

local

#define :: stream_cons

in (* in of [local] *)

implement
{a}(*tmp*)
stream_mergeq
  (xs10, xs20) = let
//
fun
auxmain:
$d2ctype
(
stream_mergeq<a>
) =
lam
(
  xs10, xs20
) =>
$delay
(
case+ !xs10 of
| x1 :: xs1 =>
  (
  case+ !xs20 of
  | x2 :: xs2 => let
      val sgn =
        stream_mergeq$cmp<a>(x1, x2)
      // end of [val]
    in
      if sgn < 0 then
        stream_cons{a}(x1, auxmain(xs1, xs20))
      else if sgn > 0 then
        stream_cons{a}(x2, auxmain(xs10, xs2))
      else
        stream_cons{a}(x1(*=x2*), auxmain(xs1, xs2))
      // end of [if]
    end // end of [::]
  | stream_nil() => stream_cons{a}(x1, xs1)
  ) (* end of [::] *)
| stream_nil() => !xs20
) (* end of [auxmain] *)
//
in
  auxmain(xs10, xs20)
end // end of [stream_mergeq]

end // end of [local]

(* ****** ****** *)
//
implement
{a}(*tmp*)
stream_mergeq$cmp
  (x1, x2) = gcompare_val_val<a>(x1, x2)
//
(* ****** ****** *)

implement
{a}(*tmp*)
stream_mergeq_fun
  (xs1, xs2, cmp) = let
//
implement{a2}
stream_mergeq$cmp(x1, x2) =
  cmp ($UN.cast{a}(x1), $UN.cast{a}(x2))
//
in
  stream_mergeq<a>(xs1, xs2)
end // end of [stream_mergeq_fun]

implement
{a}(*tmp*)
stream_mergeq_cloref
  (xs1, xs2, cmp) = let
//
implement{a2}
stream_mergeq$cmp(x1, x2) =
  cmp ($UN.cast{a}(x1), $UN.cast{a}(x2))
//
in
  stream_mergeq<a>(xs1, xs2)
end // end of [stream_mergeq_cloref]

(* ****** ****** *)
//
implement
{a}(*tmp*)
stream_union$cmp
  (x1, x2) = gcompare_val_val<a>(x1, x2)
implement
{a}(*tmp*)
stream_inter$cmp
  (x1, x2) = gcompare_val_val<a>(x1, x2)
implement
{a}(*tmp*)
stream_differ$cmp
  (x1, x2) = gcompare_val_val<a>(x1, x2)
implement
{a}(*tmp*)
stream_symdiff$cmp
  (x1, x2) = gcompare_val_val<a>(x1, x2)
//
(* ****** ****** *)

implement
{a}(*tmp*)
stream_union
(
  xs, ys
) = auxmain(xs, ys) where
{
//
fun
auxmain
( xs0: stream(a)
, ys0: stream(a)
) :<!laz> stream(a) = $delay
(
case+ !xs0 of
| stream_nil
    () => !(ys0)
  // stream_nil
| stream_cons
    (x0, xs1) =>
  (
    case+ !ys0 of
    | stream_nil() =>
      stream_cons(x0, xs1)
    | stream_cons(y0, ys1) => let
        val sgn =
        stream_union$cmp<a>(x0, y0)
      in
        ifcase
        | sgn < 0 =>
          stream_cons(x0, auxmain(xs1, ys0))
        | sgn > 0 =>
          stream_cons(y0, auxmain(xs0, ys1))
        | _(*sgn=0*) =>
          stream_cons(x0, auxmain(xs1, ys1))
      end // end of [stream_cons]
  )
) (* end of [auxmain] *)
//
} (* end of [stream_union] *)

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

implement
{a}(*tmp*)
stream_inter
(
  xs, ys
) = auxmain(xs, ys) where
{
//
fun
auxmain
( xs0: stream(a)
, ys0: stream(a)
) :<!laz> stream(a) = $delay
(
case+ !xs0 of
| stream_nil() =>
  stream_nil()
| stream_cons(x0, xs1) =>
  (
    case+ !ys0 of
    | stream_nil() =>
      stream_nil()
    | stream_cons(y0, ys1) => let
        val sgn =
        stream_inter$cmp<a>(x0, y0)
      in
        ifcase
        | sgn < 0 => !(auxmain(xs1, ys0))
        | sgn > 0 => !(auxmain(xs0, ys1))
        | _(*sgn=0*) =>
            stream_cons(x0, auxmain(xs1, ys1))
          // end of [else]
      end // end of [stream_cons]
  )
) (* end of [auxmain] *)
//
} (* end of [stream_inter] *)

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

implement
{a}(*tmp*)
stream_differ
(
  xs, ys
) = auxmain(xs, ys) where
{
//
fun
auxmain
( xs0: stream(a)
, ys0: stream(a)
) :<!laz> stream(a) = $delay
(
case+ !xs0 of
| stream_nil() =>
  stream_nil()
| stream_cons(x0, xs1) =>
  (
    case+ !ys0 of
    | stream_nil() =>
      stream_cons(x0, xs1)
    | stream_cons(y0, ys1) => let
        val sgn =
        stream_differ$cmp<a>(x0, y0)
      in
        ifcase
        | sgn < 0 =>
          stream_cons
            (x0, auxmain(xs1, ys0))
          // stream_cons
        | sgn > 0 => !(auxmain(xs0, ys1))
        | _(*sgn=0*) => !(auxmain(xs1, ys1))
      end // end of [stream_cons]
  )
) (* end of [auxmain] *)
//
} (* end of [stream_differ] *)

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

implement
{a}(*tmp*)
stream_symdiff
(
  xs, ys
) = auxmain(xs, ys) where
{
//
fun
auxmain
( xs0: stream(a)
, ys0: stream(a)
) :<!laz> stream(a) = $delay
(
case+ !xs0 of
| stream_nil
    () => !(ys0)
  // stream_nil
| stream_cons
    (x0, xs1) =>
  (
    case+ !ys0 of
    | stream_nil() =>
      stream_cons(x0, xs1)
    | stream_cons(y0, ys1) => let
        val sgn =
        stream_symdiff$cmp<a>(x0, y0)
      in
        ifcase
        | sgn < 0 =>
          stream_cons
            (x0, auxmain(xs1, ys0))
          // stream_cons
        | sgn > 0 =>
            stream_cons
            (y0, auxmain(xs0, ys1))
          // stream_cons
        | _(*sgn=0*) => !(auxmain(xs1, ys1))
      end // end of [stream_cons]
  )
) (* end of [auxmain] *)
//
} (* end of [stream_symdiff] *)

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

implement
{a}(*tmp*)
stream_tabulate
  ((*void*)) =
  auxmain(0) where
{
//
fun
auxmain{n:nat}
(
  n: int(n)
) : stream(a) = $delay
(
stream_cons{a}
  (stream_tabulate$fopr<a>(n), auxmain(n+1))
) (* end of [auxmain] *)
//
} (* end of [stream_tabulate] *)

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

implement
{a}(*tmp*)
stream_tabulate_fun
  (fopr) = let
//
implement
{a2}(*tmp*)
stream_tabulate$fopr
  (n) = $UN.cast{a2}(fopr(n))
//
in
  stream_tabulate ()
end // end of [stream_tabulate_fun]

implement
{a}(*tmp*)
stream_tabulate_cloref
  (fopr) = let
//
implement
{a2}(*tmp*)
stream_tabulate$fopr
  (n) = $UN.cast{a2}(fopr(n))
//
in
  stream_tabulate ()
end // end of [stream_tabulate_cloref]

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

implement
{a}(*tmp*)
stream_labelize(xs) = let
//
vtypedef ia = @(intGte(0), a)
//
fun
auxmain
(
i0: intGte(0)
,
xs: stream(a)
) : stream(ia) = $delay
(
(
case+ !xs of
| stream_nil
    () => stream_nil()
  // end of [stream_nil]
| stream_cons
    (x, xs) =>
    stream_cons((i0, x), auxmain(i0+1, xs))
  // end of [stream_cons]
)
) (* end of [auxmain] *)
//
in
  auxmain(0, xs)
end // end of [stream_labelize]

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

implement
{a}(*tmp*)
stream_foreach
  (xs) = let
  var env: void = ()
in
  stream_foreach_env<a><void>(xs, env)
end // end of [stream_foreach]

implement
{a}{env}
stream_foreach_env
  (xs, env) = let
//
fun loop
(
  xs: stream(a), env: &env >> _
) : void =
(
//
case+ !xs of
| stream_nil() => ()
| stream_cons(x, xs) => let
    val test =
      stream_foreach$cont<a><env>(x, env)
    // end of [val]
  in
    if test
      then let
        val () =
          stream_foreach$fwork<a><env>(x, env)
        // end of [val]
      in
        loop (xs, env)
      end // end of [then]
      else () // end of [else]
    // end of [if]
  end // end of [stream_cons]
//
) (* end of [loop] *)
//
in
  loop (xs, env)
end (* end of [stream_foreach_env] *)

implement(a,env)
stream_foreach$cont<a><env>(x0, env) = true(*cont*)

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

implement
{a}(*tmp*)
stream_foreach_fun
  (xs, fwork) =
  loop(xs) where
{
//
fun
loop(xs: stream(a)): void =
(
  case+ !xs of
  | stream_nil() => ()
  | stream_cons(x, xs) => (fwork(x); loop(xs))
)
//
} (* end of [stream_foreach_fun] *)

implement
{a}(*tmp*)
stream_foreach_cloref
  (xs, fwork) =
  loop(xs) where
{
//
fun
loop(xs: stream(a)): void =
(
  case+ !xs of
  | stream_nil() => ()
  | stream_cons(x, xs) => (fwork(x); loop(xs))
)
//
} (* end of [stream_foreach_cloref] *)

(* ****** ****** *)
//
//
implement
{a}(*tmp*)
stream_iforeach_fun
  (xs, fwork) =
  loop(0, xs) where
{
//
fun
loop
( i: intGte(0)
, xs: stream(a)): void =
(
case+ !xs of
| stream_nil() => ()
| stream_cons(x, xs) =>
  let val () = fwork(i, x) in loop(i+1, xs) end
)
//
} (* end of [stream_iforeach_fun] *)
//
implement
{a}(*tmp*)
stream_iforeach_cloref
  (xs, fwork) =
  loop(0, xs) where
{
//
fun
loop
( i: intGte(0)
, xs: stream(a)): void =
(
case+ !xs of
| stream_nil() => ()
| stream_cons(x, xs) =>
  let val () = fwork(i, x) in loop(i+1, xs) end
)
//
} (* end of [stream_iforeach_cloref] *)
//
(* ****** ****** *)

implement
{res}{a}
stream_foldleft_fun
  (xs, ini, fopr) = let
//
fun
loop(xs: stream(a), res: res): res =
(
  case+ !xs of
  | stream_nil() => res
  | stream_cons(x, xs) => loop(xs, fopr(res, x))
)
in
  loop(xs, ini)
end // end of [stream_foldleft_fun]

implement
{res}{a}
stream_foldleft_cloref
  (xs, ini, fopr) = let
//
fun
loop(xs: stream(a), res: res): res =
(
  case+ !xs of
  | stream_nil() => res
  | stream_cons(x, xs) => loop(xs, fopr(res, x))
)
in
  loop(xs, ini)
end // end of [stream_foldleft_cloref]

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

implement
{a}(*tmp*)
fprint_stream
  (out, xs, n) = let
//
var env: int = 0
typedef tenv = int
//
implement
stream_foreach$cont<a><tenv>
  (x, env) =
  if n > env then true else false
implement
stream_foreach$fwork<a><tenv>
  (x, env) =
{
  val () =
  if env > 0
    then fprint_stream$sep<>(out)
  // end of [if]
  val () = env := env + 1
  val () = fprint_val<a>(out, x)
} (* end of [stream_foreach$fwork] *)
//
in
  stream_foreach_env<a><tenv>(xs, env)
end // end of [fprint_stream]

implement
{}(*tmp*)
fprint_stream$sep (out) = fprint_string (out, ", ")

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

implement
{a}(*tmp*)
stream_skip_while_cloref
  (xs0, test) = let
//
val p0 = addr@xs0
//
fun
loop
(
xs: stream(a), n0: intGte(0)
) : intGte(0) =
(
case+ !xs of
| stream_nil() => n0 where
  {
    val () = $UN.ptr0_set<stream(a)>(p0, xs)
  }
| stream_cons(x1, xs2) =>
  if test(x1) then loop(xs2, n0+1) else
    (let val () = $UN.ptr0_set<stream(a)>(p0, xs) in n0 end)
  // end of [if] // end of [stream_cons]
)
//
in
  loop(xs0, 0)
end // end of [stream_skip_while_cloref]

implement
{a}(*tmp*)
stream_skip_until_cloref
  (xs0, test) = let
//
var
test_not = lam@(x: a) =<clo1> ~test(x)
//
in
  stream_skip_while_cloref<a>(xs0, $UN.cast(addr@test_not))
end // end of [stream_skip_until_cloref]

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

(* end of [stream.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(* Author: Hongwei Xi *)
(* Start time: July, 2012 *)
(* Authoremail: gmhwxiATgmailDOTcom *)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/list.atxt
** Time of generation: Fri Aug 18 03:30:03 2017
*)

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

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

(* ****** ****** *)
//
implement
{a}(*tmp*)
stream_vt_is_nil(xs) =
(
case+ !xs of
| ~stream_vt_nil() => true
| ~stream_vt_cons(_, xs) => (~xs; false)
)
implement
{a}(*tmp*)
stream_vt_is_cons(xs) =
  not(stream_vt_is_nil<a>(xs))
//
(* ****** ****** *)
//
implement
{a}(*tmp*)
stream_vt_make_nil
  ((*void*)) = $ldelay(stream_vt_nil)
//
implement
{a}(*tmp*)
stream_vt_make_cons(x, xs) =
$ldelay(
  stream_vt_cons(x, xs), $effmask_wrt(~xs)
)(*$ldelay*)
//
(* ****** ****** *)
//
implement
{a}(*tmp*)
stream_vt_sing(x) =
stream_vt_cons{a}(x, stream_vt_make_nil())
implement
{a}(*tmp*)
stream_vt_make_sing(x) =
stream_vt_make_cons<a>(x, stream_vt_make_nil())
//
(* ****** ****** *)
//
implement
{a}(*tmp*)
stream_vt_make_con(xs_con) =
(
//
$ldelay
(
  xs_con
, $effmask_wrt(stream_vt_con_free<a>(xs_con))
)
//
) (* end of [stream_vt_make_con] *)
//
(* ****** ****** *)
//
// HX-2014-04-07:
// This is a wild implementation!
//
implement
{a}(*tmp*)
stream_vt2t(xs) = let
//
fun
aux (
  xs: stream_vt(a)
) :<!laz> stream(a) = let
//
val xs = $UN.castvwtp0{ptr}(xs)
//
in
//
$delay
(
let
  val xs =
    $UN.castvwtp0{stream_vt(a)}(xs)
  val xs_con = !xs
in
  case+ xs_con of
  | ~stream_vt_nil
      ((*void*)) => stream_nil(*void*)
    // end of [stream_vt_nil]
  | @stream_vt_cons
      (x, xs1) => let
      val xs1_val = xs1
      val ((*void*)) = (xs1 := aux (xs1_val))
    in
      $UN.castvwtp0{stream_con(a)}((view@x, view@xs1 | xs_con))
    end // end of [stream_cons]
end
)
end // end of [aux]
//
in
  aux (xs)
end // end of [stream_vt2t]

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

local
//
// HX-2012:
// casting stream_vt_cons to list_cons
//
extern
castfn
stream2list_vt_cons
  {l0,l1,l2:addr}
(
  stream_vt_cons_unfold (l0, l1, l2)
) :<> list_vt_cons_unfold (l0, l1, l2)

in (* in-of-local *)

implement
{a}(*tmp*)
stream2list_vt(xs) = let
//
fun
loop (
  xs: stream_vt a
) :<!laz> List0_vt (a) = let
  val xs_con = !xs
in
  case+ xs_con of
  | ~stream_vt_nil
      ((*void*)) => list_vt_nil()
    // end of [stream_vt_nil]
  | @stream_vt_cons
      (x, xs1) => let
      val xs1_ = xs1
      val xs_con =
        stream2list_vt_cons(xs_con)
      // end of [val]
      val ((*void*)) = (xs1 := loop(xs1_))
    in
      fold@ (xs_con); xs_con
    end // end of [stream_vt_cons]
end // end of [loop]
//
in
  loop (xs)
end // end of [stream2list_vt]

end // end of [local]

(* ****** ****** *)
//
implement
{a}(*tmp*)
stream_vt_free(xs) = ~(xs)
//
implement
{a}(*tmp*)
stream_vt_con_free
  (xs_con) =
(
  case+ xs_con of
  | ~stream_vt_nil() => () | ~stream_vt_cons(_, xs) => ~xs
) (* stream_vt_con_free *)
//
(* ****** ****** *)

implement
{a}(*tmp*)
stream_vt_takeLte
  (xs, n) = let
//
fun
auxmain
(
xs:
stream_vt(a), n: intGte(0)
) : stream_vt(a) = $ldelay(
if
(n > 0)
then let
  val xs_con = !xs
in
//
case+ xs_con of
| ~stream_vt_nil
    () => stream_vt_nil()
| @stream_vt_cons
    (x, xs) => let
    val ((*void*)) =
      xs := auxmain(xs, n-1)
    // end of [val]
  in
    fold@(xs_con); xs_con
  end // end of [stream_vt_cons]
//
end // end of [then]
else (~xs; stream_vt_nil())
,
(~xs) // for freeing the stream!
)
//
in
  auxmain(xs, n)
end // end of [stream_vt_takeLte]

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

(*
implement
{a}(*tmp*)
stream_vt_dropLte
  (xs, n) = let
//
fun aux
  : $d2ctype(stream_vt_dropLte<a>) =
lam (xs, n) =>
(
if
n > 0
then (
case+ !xs of
| ~stream_vt_nil
    ((*void*)) => stream_vt_make_nil()
| ~stream_vt_cons(_, xs) => aux(xs, n-1)
) else (xs)
) (* end of [lam] *)
//
in
  aux (xs, n)
end // end of [stream_vt_dropLte]
*)

(* ****** ****** *)
//
implement
{a}(*tmp*)
stream_vt_drop_exn
  (xs, n) = let
//
fun aux
  : $d2ctype(stream_vt_drop_exn<a>) =
lam (xs, n) =>
(
//
if
n > 0
then (
//
case+ !xs of
| ~stream_vt_cons
    (_, xs) => aux(xs, n-1)
  // end of [stream_vt_cons]
| ~stream_vt_nil
    ((*void*)) => $raise StreamSubscriptExn()
  // end of [stream_vt_nil]
//
) (* end of [then] *)
else (xs) // end of [else]
//
) (* end of [lam] *)
//
in
  aux (xs, n)
end // end of [stream_vt_drop_exn]
//
implement
{a}(*tmp*)
stream_vt_drop_opt
  (xs, n) = let
//
fun aux
  : $d2ctype(stream_vt_drop_opt<a>) =
lam (xs, n) =>
(
//
if
n > 0
then (
//
case+ !xs of
| ~stream_vt_cons
    (_, xs) => aux(xs, n-1)
| ~stream_vt_nil
    ((*void*)) => None_vt((*void*))
//
) (* end of [then] *)
else Some_vt{stream_vt(a)}(xs) // [else]
//
) (* end of [lam] *)
//
in
  aux (xs, n)
end // end of [stream_vt_drop_opt]
//
(* ****** ****** *)
//
implement
{a}(*tmp*)
stream_vt_head_exn(xs) =
(
case+ !xs of
| ~stream_vt_cons (x, xs) =>
    let val () = stream_vt_free(xs) in x end
| ~stream_vt_nil ((*void*)) => $raise StreamSubscriptExn()
) (* end of [stream_vt_head_exn] *)
//
implement
{a}(*tmp*)
stream_vt_tail_exn(xs) =
(
case+ !xs of
| ~stream_vt_cons (x, xs) => (xs)
| ~stream_vt_nil ((*void*)) => $raise StreamSubscriptExn()
) (* end of [stream_vt_tail_exn] *)
//
(* ****** ****** *)

implement
{a}(*tmp*)
stream_vt_uncons_exn(xs0) =
(
case+ !xs0 of
| ~stream_vt_cons
    (x, xs) => (xs0 := xs; x)
| ~stream_vt_nil () => let
    val () =
      xs0 := $ldelay (stream_vt_nil)
    // end of [val]
  in
    $raise StreamSubscriptExn((*void*))
  end // end of [stream_vt_nil]
) (* end of [stream_vt_uncons_exn] *)

implement
{a}(*tmp*)
stream_vt_uncons_opt(xs0) =
(
case+ !xs0 of
| ~stream_vt_cons
    (x, xs) =>
  (
    xs0 := xs; Some_vt(x)
  )
| ~stream_vt_nil() => let
    val () =
      xs0 := $ldelay(stream_vt_nil) in None_vt()
    // end of [val]
  end // end of [stream_vt_nil]
) (* end of [stream_vt_uncons_opt] *)

(* ****** ****** *)
//
implement
{a}(*tmp*)
stream_vt_last_exn(xs) = let
//
fun
loop(x0: a, xs: stream_vt(a)) =
(
case+ !xs of
| ~stream_vt_nil((*void*)) => x0
| ~stream_vt_cons(x1, xs) => loop(x1, xs)
) (* end of [loop] *)
//
in
//
case+ !xs of
| ~stream_vt_nil
    () => $raise StreamSubscriptExn()
| ~stream_vt_cons
    (x0, xs) => $effmask_all(loop(x0, xs))
//
end // end of [stream_vt_last_exn]
//
implement
{a}(*tmp*)
stream_vt_last_opt(xs) = let
//
fun
loop(x0: a, xs: stream_vt(a)) =
(
case+ !xs of
| ~stream_vt_nil((*void*)) => x0
| ~stream_vt_cons(x1, xs) => loop(x1, xs)
) (* end of [loop] *)
//
in
//
case+ !xs of
| ~stream_vt_nil
    () => None_vt((*void*))
| ~stream_vt_cons
    (x0, xs) => $effmask_all(Some_vt(loop(x0, xs)))
//
end // end of [stream_vt_last_opt]
//
(* ****** ****** *)

implement
{a}(*tmp*)
stream_vt_length(xs0) = let
//
fun
loop
(
  xs: stream_vt(a), n: intGte(0)
) : intGte(0) =
(
  case+ !xs of
  | ~stream_vt_nil() => n
  | ~stream_vt_cons(_, xs) => loop(xs, n+1)
) (* end of [loop] *)
//
in
  $effmask_all(loop(xs0, 0))
end // end of [stream_vt_length]

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

implement
{a}(*tmp*)
stream_vt_nth_exn
  (xs, n) =
  loop(xs, n) where
{
//
fun
loop:
$d2ctype
(
  stream_vt_nth_exn<a>
) = lam(xs, n) =>
(
  case+ !xs of
  | ~stream_vt_nil() =>
      $raise StreamSubscriptExn()
  | ~stream_vt_cons(x, xs) =>
      if n = 0 then (~xs; x) else loop(xs, pred(n))
) (* end of [loop] *)
//
} (* end of [stream_vt_nth_exn] *)

implement
{a}(*tmp*)
stream_vt_nth_opt
  (xs, n) =
  loop(xs, n) where
{
//
fun
loop:
$d2ctype
(
  stream_vt_nth_opt<a>
) = lam(xs, n) =>
(
  case+ !xs of
  | ~stream_vt_nil() => None_vt()
  | ~stream_vt_cons(x, xs) =>
      if n = 0 then (~xs; Some_vt(x)) else loop(xs, pred(n))
) (* end of [loop] *)
//
} (* end of [stream_vt_nth_opt] *)

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

implement
{a}(*tmp*)
stream_vt_append
  (xs, ys) =
  auxmain(xs, ys) where
{
//
fun
auxmain:
$d2ctype
(
stream_vt_append<a>
) =
lam(xs, ys) => $ldelay(
//
let
//
val xs_con = !xs
//
in
//
case+ xs_con of
| ~stream_vt_nil() => !ys
| @stream_vt_cons(x, xs) => let
    val () =
    (
      xs := auxmain(xs, ys)
    ) (* end of [val] *)
    prval () = fold@{a}(xs_con) in xs_con
  end // end of [stream_vt_cons]
//
end // end-of-let
,
(
  ~(xs); ~(ys)
) // HX: for freeing the stream!
//
) (* end of [auxmain] *)
//
} (* end of [stream_vt_append] *)

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

implement
{a}(*tmp*)
stream_vt_concat
  (xss) =
  auxmain(xss) where {
//
vtypedef
stream1_vt = stream_vt(a)
vtypedef
stream2_vt = stream_vt(stream1_vt)
//
fun
auxmain
(
  xss: stream2_vt
) : stream1_vt = $ldelay
(
(
case+ !xss of
| ~stream_vt_nil
    () => stream_vt_nil()
  // end of [stream_vt_nil]
| ~stream_vt_cons
    (xs, xss) =>
    !(stream_vt_append<a>(xs, auxmain(xss)))
  // end of [stream_vt_cons]
)
,
(
  ~xss
) (* HX: freeing the stream! *)
)
//
} (* end of [stream_vt_concat] *)

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

implement
{a}(*tmp*)
stream_vt_filter
  (xs) = auxmain(xs) where
{
//
fun
auxmain
(
xs: stream_vt(a)
) : stream_vt(a) = $ldelay
(
//
let
  val xs_con = !xs
in
//
case+ xs_con of
| ~stream_vt_nil
    ((*_*)) => stream_vt_nil()
  // end of [stream_vt_nil]
| @stream_vt_cons
    (x, xs1) => let
    val test =
      stream_vt_filter$pred<a>(x)
    // end of [val]
  in
    if test
      then let
        val () =
        xs1 := auxmain(xs1)
      in
        fold@{a}(xs_con); xs_con
      end // end of [then]
      else let
        val xs1 = xs1
      in
        free@{a}(xs_con); !(auxmain(xs1))
      end // end of [else]
    // end of [if]
  end // end of [stream_vt_cons]
//
end // end of [let]
//
,
//
(
  ~xs
) (* HX: for freeing the stream! *)
//
) (* end of auxmain *)
//
} (* end of [stream_vt_filter] *)

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

implement
{a}(*tmp*)
stream_vt_filter_fun
  (xs, pred) = let
//
implement{a2}
stream_vt_filter$pred(x) = let
//
val p = addr@(x)
val (pf, fpf | p) = $UN.ptr0_vtake{a}(p)
val test = pred(!p)
prval ((*void*)) = fpf (pf)
//
in
  test
end // end of [stream_vt_filter$pred]
//
in
  stream_vt_filter<a>(xs)
end // end of [stream_vt_filter_fun]

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

implement
{a}(*tmp*)
stream_vt_filter_cloptr
(
  xs, pred
) = auxmain(xs, pred) where
{
//
fun
auxmain
(
//
xs: stream_vt(a),
pred: (&a) -<cloptr1> bool
//
) : stream_vt(a) = $ldelay
(
//
let
  val xs_con = !xs
in
//
case+ xs_con of
| ~stream_vt_nil
    ((*_*)) => let
    val () =
    cloptr_free
      ($UN.castvwtp0{cloptr0}(pred))
    // end of [val]
  in
    stream_vt_nil(*void*)
  end // end of [stream_vt_nil]
| @stream_vt_cons
    (x, xs1) => let
    val test = pred(x)
  in
    if test
      then let
        val () =
        xs1 := auxmain(xs1, pred)
      in
        fold@{a}(xs_con); xs_con
      end // end of [then]
      else let
        val xs1 = xs1
      in
        free@{a}(xs_con); !(auxmain(xs1, pred))
      end // end of [else]
    // end of [if]
  end // end of [stream_vt_cons]
//
end // end of [let]
//
,
//
(
  ~xs;
  cloptr_free($UN.castvwtp0{cloptr0}(pred))
)
//
) (* end of auxmain *)
//
} (* end of [stream_vt_filter_cloptr] *)

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

implement
{a}(*tmp*)
stream_vt_ifilter_cloptr
  (xs, pred) = let
//
fun
auxmain
(
//
  i0: intGte(0)
, xs: stream_vt(a)
, pred: (intGte(0), &a) -<cloptr1> bool
//
) : stream_vt(a) = $ldelay
(
//
let
  val xs_con = !xs
in
//
case+ xs_con of
| ~stream_vt_nil
    ((*_*)) => let
    val () =
    cloptr_free
    (
      $UN.castvwtp0{cloptr0}(pred)
    ) (* cloptr_free *)
  in
    stream_vt_nil(*void*)
  end // end of [stream_vt_nil]
| @stream_vt_cons
    (x, xs1) => let
    val test = pred(i0, x)
  in
    if test
      then let
        val () =
        xs1 :=
        auxmain
        (
          i0+1, xs1, pred
        ) (* end-of-val *)
      in
        fold@{a}(xs_con); xs_con
      end // end of [then]
      else let
        val xs1 = xs1
      in
        free@{a}(xs_con);
        !(auxmain(i0+1, xs1, pred))
      end // end of [else]
    // end of [if]
  end // end of [stream_vt_cons]
//
end // end of [let]
//
,
//
(
  ~xs;
  cloptr_free($UN.castvwtp0{cloptr0}(pred))
)
//
) (* end of auxmain *)
//
in
  auxmain(0, xs, pred)
end (* end of [stream_vt_ifilter_cloptr] *)

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

implement
{a}(*tmp*)
stream_vt_filterlin
  (xs) = auxmain(xs) where
{
//
fun
auxmain
(
xs: stream_vt(a)
) : stream_vt(a) = $ldelay
(
//
let
  val xs_con = !xs
in
//
case+ xs_con of
| ~stream_vt_nil
    ((*_*)) => stream_vt_nil()
  // end of [stream_vt_nil]
| @stream_vt_cons
    (x, xs1) => let
    val test =
      stream_vt_filterlin$pred<a>(x)
    // end of [val]
  in
    if test
      then let
        val () =
        xs1 := auxmain(xs1)
      in
        fold@{a}(xs_con); xs_con
      end // end of [then]
      else let
        val () =
          stream_vt_filterlin$clear<a>(x)
        // end of [val]
      in
        let val xs1 = xs1 in free@{a}(xs_con); !(auxmain(xs1)) end
      end // end of [else]
    // end of [if]
  end // end of [stream_vt_cons]
//
end // end of [let]
//
,
//
(
  ~xs
) (* HX: for freeing the stream! *)
//
) (* end of auxmain *)
//
} (* end of [stream_vt_filterlin] *)

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

implement
{a}{b}(*tmp*)
stream_vt_map(xs) = let
//
fun
auxmain
(
//
xs: stream_vt(a)
//
) : stream_vt(b) = $ldelay
(
//
let
  val xs_con = !xs
in
//
case+
xs_con
of // case+
//
| ~stream_vt_nil
    ((*void*)) => stream_vt_nil()
  // end of [stream_vt_nil]
| @stream_vt_cons(x, xs) => let
    val y =
    stream_vt_map$fopr<a><b> (x)
    val xs = xs
    val ((*void*)) = free@ (xs_con)
  in
    stream_vt_cons{b}(y, auxmain(xs))
  end (* end of [stream_vt_con] *)
//
end // end of [let]
//
,
//
(
  ~xs
) (* HX: for freeing the stream! *)
//
) (* end of [auxmain] *)
//
in
  auxmain(xs)
end // end of [stream_vt_map]

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

implement
{a}{b}(*tmp*)
stream_vt_map_fun
  (xs, fopr) = let
//
implement
{a2}{b2}
stream_vt_map$fopr
  (x) = res where
{
//
prval() = __assert(x) where
{
  extern praxi __assert(x: &a2 >> a2?!): void
}
val (
  pf, fpf | p_x
) = $UN.ptr0_vtake{a}(addr@x)
val res = $UN.castvwtp0{b2}(fopr(!p_x))
prval() = $UN.castview0{void}(@(fpf, pf))
//
} (* end of [stream_vt_map$fopr] *)
//
in
  stream_vt_map<a><b>(xs)
end // end of [stream_vt_map_fun]

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

implement
{a}{b}(*tmp*)
stream_vt_map_cloptr
  (xs, fopr) = let
//
fun
auxmain:
$d2ctype
(
stream_vt_map_cloptr<a><b>
) =
lam(xs, fopr) => $ldelay (
//
let
  val xs_con = !xs
in
  case+ xs_con of
  | ~stream_vt_nil
      () => let
    //
      val () =
      cloptr_free
      (
        $UN.castvwtp0{cloptr0}(fopr)
      )
    //
    in
      stream_vt_nil()
    end // end of [stream_vt_nil]
  | @stream_vt_cons
      (x, xs) => let
      val y = fopr(x)
      val xs = xs
      val () = free@{a?}(xs_con)
    in
      stream_vt_cons(y, auxmain(xs, fopr))
    end // end of [stream_vt_cons]
end // end of [let]
,
(~xs; cloptr_free($UN.castvwtp0{cloptr0}(fopr)))
//
) (* end of [auxmain] *)
//
in
  auxmain(xs, fopr)
end // end of [stream_vt_map_cloptr]

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

implement
{a}{b}(*tmp*)
stream_vt_imap(xs) = let
//
fun
auxmain
(
//
i0: intGte(0)
,
xs: stream_vt(a)
//
) : stream_vt(b) = $ldelay
(
//
let
  val xs_con = !xs
in
//
case+
xs_con
of // case+
//
| ~stream_vt_nil
    ((*void*)) => stream_vt_nil()
  // end of [stream_vt_nil]
| @stream_vt_cons(x, xs) => let
    val y =
    stream_vt_imap$fopr<a><b>(i0, x)
    val xs = xs
    val ((*void*)) = free@ (xs_con)
  in
    stream_vt_cons{b}(y, auxmain(i0+1, xs))
  end (* end of [stream_vt_con] *)
//
end // end of [let]
//
,
//
(
  ~xs
) (* HX: for freeing the stream! *)
//
) (* end of [auxmain] *)
//
in
  auxmain(0(*i*), xs)
end // end of [stream_vt_imap]

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

implement
{a}{b}(*tmp*)
stream_vt_imap_fun
  (xs, fopr) = let
//
implement
{a2}{b2}
stream_vt_imap$fopr
  (i, x) = res where
{
//
prval() = __assert(x) where
{
  extern
  praxi __assert(x: &a2 >> a2?!): void
}
val (
  pf, fpf | p_x
) = $UN.ptr0_vtake{a}(addr@x)
val res =
  $UN.castvwtp0{b2}(fopr(i, !p_x))
//
prval() = $UN.castview0{void}(@(fpf, pf))
//
} (* end of [stream_vt_map$fopr] *)
//
in
  stream_vt_imap<a><b>(xs)
end // end of [stream_vt_imap_fun]

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

implement
{a}{b}(*tmp*)
stream_vt_imap_cloptr
  (xs, fopr) = let
//
fun
auxmain
(
i0: intGte(0),
xs: stream_vt(a),
fopr: (intGte(0), &a >> a?!) -<cloptr1> b
) : stream_vt(b) = $ldelay
(
let
  val xs_con = !xs
in
  case+ xs_con of
  | ~stream_vt_nil
      () => let
    //
      val () =
      cloptr_free
      (
        $UN.castvwtp0{cloptr0}(fopr)
      )
    //
    in
      stream_vt_nil()
    end // end of [stream_vt_nil]
  | @stream_vt_cons
      (x, xs) => let
      val y = fopr(i0, x)
      val xs = xs
      val () = free@{a?}(xs_con)
    in
      stream_vt_cons(y, auxmain(i0+1, xs, fopr))
    end // end of [stream_vt_cons]
end // end of [let]
,
(~xs; cloptr_free($UN.castvwtp0{cloptr0}(fopr)))
) (* end of [auxmain] *)
//
in
  auxmain(0, xs, fopr)
end // end of [stream_vt_imap_cloptr]

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

implement
{a}{b}(*tmp*)
stream_vt_mapopt(xs) = let
//
fun
auxmain
(
//
xs: stream_vt(a)
//
) : stream_vt(b) = $ldelay
(
//
let
  val xs_con = !xs
in
//
case+
xs_con
of // case+
//
| ~stream_vt_nil
    ((*void*)) => stream_vt_nil()
  // end of [stream_vt_nil]
| @stream_vt_cons(x, xs) => let
    val oy =
    stream_vt_mapopt$fopr<a><b> (x)
    val xs = xs
    val ((*void*)) = free@ (xs_con)
  in
    case+ oy of
    | ~None_vt() => !(auxmain(xs))
    | ~Some_vt(y) => stream_vt_cons{b}(y, auxmain(xs))
  end (* end of [stream_vt_con] *)
//
end // end of [let]
//
,
//
(
  ~xs
) (* HX: for freeing the stream! *)
//
) (* end of [auxmain] *)
//
in
  auxmain(xs)
end // end of [stream_vt_mapopt]

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

implement
{a}{b}(*tmp*)
stream_vt_mapopt_fun
  (xs, fopr) = let
//
implement
{a2}{b2}
stream_vt_mapopt$fopr
  (x) = res where
{
//
vtypedef
ob2 = Option_vt(b2)
//
prval() = __assert(x) where
{
  extern praxi __assert(x: &a2 >> a2?!): void
}
val (
  pf, fpf | p_x
) = $UN.ptr0_vtake{a}(addr@x)
val res = $UN.castvwtp0{ob2}(fopr(!p_x))
prval() = $UN.castview0{void}(@(fpf, pf))
//
} (* end of [stream_vt_map$fopr] *)
//
in
  stream_vt_mapopt<a><b>(xs)
end // end of [stream_vt_mapopt_fun]

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

implement
{a}{b}(*tmp*)
stream_vt_mapopt_cloptr
  (xs, fopr) = let
//
fun
auxmain:
$d2ctype
(
stream_vt_mapopt_cloptr<a><b>
) =
lam
(
xs, fopr
) => $ldelay (
//
let
  val xs_con = !xs
in
  case+ xs_con of
  | ~stream_vt_nil
      () => let
    //
      val () =
      cloptr_free
      (
        $UN.castvwtp0{cloptr0}(fopr)
      )
    //
    in
      stream_vt_nil()
    end // end of [stream_vt_nil]
  | @stream_vt_cons
      (x, xs) => let
      val oy = fopr(x)
      val xs = xs
      val () = free@{a?}(xs_con)
    in
      case+ oy of
      | ~None_vt() =>
        !(auxmain(xs, fopr))
      | ~Some_vt(y) =>
        stream_vt_cons(y, auxmain(xs, fopr))
    end // end of [stream_vt_cons]
end // end of [let]
,
(~xs; cloptr_free($UN.castvwtp0{cloptr0}(fopr)))
//
) (* end of [auxmain] *)
//
in
  auxmain(xs, fopr)
end // end of [stream_vt_mapopt_cloptr]

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

implement
{a1,a2}{b}
stream_vt_map2
  (xs1, xs2) =
  auxmain(xs1, xs2) where
{
//
fun
auxmain
(
  xs1: stream_vt(a1)
, xs2: stream_vt(a2)
) : stream_vt(b) = $ldelay
(
let
  val xs1_con = !xs1
in
//
case+ xs1_con of
| ~stream_vt_nil
    ((*_*)) => (~(xs2); stream_vt_nil())
  // end of [stream_vt_nil]
| @stream_vt_cons
    (x1, xs1) => let
    val xs2_con = !xs2
  in
    case+ xs2_con of
    | ~stream_vt_nil
        ((*_*)) => let
        val xs1 = xs1
        val () = free@ (xs1_con)
      in
        ~(xs1); stream_vt_nil ()
      end // end of [stream_vt_nil]
    | @stream_vt_cons
        (x2, xs2) => let
        val y =
        stream_vt_map2$fopr<a1,a2><b> (x1, x2)
        val xs1 = xs1
        and xs2 = xs2
        val () = free@ (xs1_con)
        and () = free@ (xs2_con)
      in
        stream_vt_cons{b}
          (y, stream_vt_map2<a1,a2><b> (xs1, xs2))
        // end of [stream_vt_cons]
      end // end of [stream_vt_cons]
  end // end of [stream_vt_cons]
//
end // end of [let]
,
//
(
  ~(xs1); ~(xs2)
) (* HX: for freeing the stream! *)
//
) (* $ldelay] *) // end of [auxmain]
//
} (* end of [stream_vt_map2] *)

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

implement
{a1,a2}{b}
stream_vt_map2_fun
  (xs1, xs2, fopr) = let
//
implement
{a12,a22}{b2}
stream_vt_map2$fopr
  (x1, x2) = res where
{
//
val (
  pf1, fpf1 | p_x1
) = $UN.ptr0_vtake{a1}(addr@x1)
and (
  pf2, fpf2 | p_x2
) = $UN.ptr0_vtake{a2}(addr@x2)
//
val res =
  $UN.castvwtp0{b2}(fopr(!p_x1, !p_x2))
//
prval() = fpf1 (pf1) and () = fpf2 (pf2)
//
} (* end of [stream_vt_map2$fopr] *)
//
in
  stream_vt_map2<a1,a2><b> (xs1, xs2)
end // end of [stream_vt_map2_fun]

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

implement
{res}{a}
stream_vt_scan_cloptr
  (xs, ini, fopr) = let
//
fun
auxmain:
$d2ctype
(
stream_vt_scan_cloptr<res><a>
) =
lam
(
  xs, ini, fopr
) => $ldelay
(
let
  val xs_con = !xs
in
//
case+ xs_con of
| ~stream_vt_nil
    () => let
  //
    val () =
    cloptr_free
    (
      $UN.castvwtp0{cloptr0}(fopr)
    )
  //
  in
    stream_vt_nil()
  end // end of [stream_vt_nil]
| @stream_vt_cons
    (x, xs) => let
    val xs = xs
    val ini = fopr(ini, x)
    val ((*freed*)) = free@(xs_con)
  in
    stream_vt_cons(ini, auxmain(xs, ini, fopr))
  end // end of [stream_vt_cons]
end // end of [let]
,
(~xs; cloptr_free($UN.castvwtp0{cloptr0}(fopr)))
) (* end of [auxmain] *)
//
in
  stream_vt_make_cons<res>(ini, auxmain(xs, ini, fopr))
end // end of [stream_vt_scan_cloptr]

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

implement
{a}(*tmp*)
stream_vt_tabulate
(
// argumentless
) = auxmain(0) where
{
//
fun
auxmain
(
i : intGte(0)
) : stream_vt(a) =
(
$ldelay
(
stream_vt_cons
(
  stream_vt_tabulate$fopr<a>(i), auxmain(i+1)
)
) (* $ldelay *)
) (* end of [aux] *)
//
} (* end of [stream_vt_tabulate] *)

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

implement
{a}(*tmp*)
stream_vt_labelize(xs) = let
//
vtypedef ia = @(intGte(0), a)
//
fun
auxmain
(
  i0: intGte(0)
, xs: stream_vt(a)
) : stream_vt(ia) = $ldelay
(
(
case+ !xs of
| ~stream_vt_nil
    () => stream_vt_nil()
  // end of [stream_vt_nil]
| ~stream_vt_cons
    (x, xs) =>
    stream_vt_cons((i0, x), auxmain(i0+1, xs))
  // end of [stream_vt_cons]
)
,
(
  ~xs
) // HX: for freeing the stream!
) (* end of [auxmain] *)
//
in
  auxmain(0, xs)
end // end of [stream_vt_labelize]

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

implement
{a}(*tmp*)
stream_vt_foreach
  (xs) = let
//
var env: void = ((*void*))
//
in
  stream_vt_foreach_env<a><void>(xs, env)
end // end of [stream_vt_foreach]

implement
{a}{env}(*tmp*)
stream_vt_foreach_env
  (xs, env) = let
//
fun
loop
(
  xs: stream_vt(a)
, env: &env >> env
) : stream_vt_con(a) = let
//
val xs_con = !xs
//
in
//
case+ xs_con of
| @stream_vt_cons
    (x, xs1) => let
    val test =
    stream_vt_foreach$cont<a>(x, env)
  in
    if test
      then let
        val xs1 = xs1
        val ((*void*)) =
        stream_vt_foreach$fwork<a>(x, env)
        val ((*freed*)) = free@{a}(xs_con)
      in
        loop(xs1, env)
      end else let
        prval((*folded*)) = fold@(xs_con) in xs_con
      end // end of [if]
  end // end of [stream_vt_cons]
| ~stream_vt_nil((*void*)) => stream_vt_nil()
//
end // end of [loop]
//
in
  loop(xs, env)
end // end of [stream_vt_foreach_env]

implement(a,env)
stream_vt_foreach$cont<a><env>(x0, env) = true(*cont*)

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

implement
{a}(*tmp*)
stream_vt_foreach_cloptr
  (xs, fwork) = let
//
fun
loop :
$d2ctype
(
  stream_vt_foreach_cloptr<a>
) =
lam(xs, fwork) => let
  val xs_con = !xs
in
//
case+ xs_con of
| ~stream_vt_nil() =>
    cloptr_free
      ($UN.castvwtp0{cloptr0}(fwork))
    // cloptr_free
| @stream_vt_cons(x, xs) =>
    let val xs = xs in
      fwork(x); free@{a?}(xs_con); loop(xs, fwork)
    end // end of [let]
end // end of [let] // end of [lam]
//
in
  loop(xs, fwork)
end // end of [stream_vt_foreach_cloptr]

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

implement
{a}(*tmp*)
stream_vt_rforeach_cloptr
  (xs, fwork) = let
//
fun
aux0
(
  xs: stream_vt(a)
, fwork: !(&a >> a?!) -<cloptr1> void
) : void = let
  val xs_con = !xs
in
//
case+ xs_con of
| ~stream_vt_nil() => ()
| @stream_vt_cons(x, xs) =>
  (
    aux0(xs, fwork);
    fwork(x); free@{a?}(xs_con)
  ) (* stream_vt_cons *)
end // end of [let] // end of [lam]
//
val ((*void*)) = aux0(xs, fwork)
//
in
//
cloptr_free($UN.castvwtp0{cloptr0}(fwork))
//
end // end of [stream_vt_rforeach_cloptr]

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

implement
{a}(*tmp*)
stream_vt_iforeach_cloptr
  (xs, fwork) = let
//
fun
loop (
  i0: intGte(0)
, xs: stream_vt(a)
, fwork: (intGte(0), &a >> a?!) -<cloptr1> void
) : void = let
//
  val xs_con = !xs
//
in
//
case+ xs_con of
| ~stream_vt_nil() =>
    cloptr_free
      ($UN.castvwtp0{cloptr0}(fwork))
    // cloptr_free
| @stream_vt_cons(x, xs) =>
    let val xs = xs in
      fwork(i0, x); free@{a?}(xs_con); loop(i0+1, xs, fwork)
    end // end of [let]
end // end of [let] // end of [lam]
//
in
  loop(0(*i0*), xs, fwork)
end // end of [stream_vt_iforeach_cloptr]

(* ****** ****** *)
//
implement
{res}{a}
stream_vt_foldleft_cloptr
  (xs, init, fopr) =
  loop(xs, init, fopr) where
{
//
fun
loop:
$d2ctype
(stream_vt_foldleft_cloptr<res><a>) =
lam
(
xs, res, fopr
) => let
  var xs_con = !xs
in
//
case+
xs_con
of // case+
| ~stream_vt_nil
    () =>
  (
    cloptr_free($UN.castvwtp0(fopr)); res
  ) (* end of [stream_vt_nil] *)
| @stream_vt_cons
    (x0, xs1) => let
    val res = fopr(res, x0)
    val xs1 = xs1 in free@(xs_con); loop(xs1, res, fopr)
  end // end of [stream_vt_cons]
//
end // end of [loop]
//
} (* end of [stream_vt_foldleft_cloptr] *)
//
(* ****** ****** *)
//
implement
{res}{a}
stream_vt_ifoldleft_cloptr
  (xs, init, fopr) =
  loop(0, xs, init, fopr) where
{
//
fun
loop
(
i0: Nat,
xs: stream_vt(a), res: res,
fopr: (Nat, res, &a >> a?!) -<cloptr1> res
) : res = let
  var xs_con = !xs
in
//
case+
xs_con
of // case+
| ~stream_vt_nil
    () =>
  (
    cloptr_free($UN.castvwtp0(fopr)); res
  ) (* end of [stream_vt_nil] *)
| @stream_vt_cons
    (x0, xs1) => let
    val res = fopr(i0, res, x0)
    val xs1 = xs1 in free@(xs_con); loop(i0+1, xs1, res, fopr)
  end // end of [stream_vt_cons]
//
end // end of [loop]
//
} (* end of [stream_vt_ifoldleft_cloptr] *)
//
(* ****** ****** *)

implement
{env}{a}
stream_vt_unfold
(
  st0, fopr
) = aux(st0) where
{
//
fun aux
(
  st: env
) : stream_vt(a) = $ldelay
(
let
  var st = st;
  val x0 = fopr(st)
in
  stream_vt_cons{a}(x0, aux(st))
end // end of [aux]
)
//
} (* end of [stream_vt_unfold] *)

implement
{env}{a}
stream_vt_unfold_opt
(
  st0, fopr
) = aux(st0) where
{
//
fun aux
(
  st: env
) : stream_vt(a) = $ldelay
(
let
  var st = st;
  val opt = fopr(st)
in
  case+ opt of
  | ~None_vt() => stream_vt_nil()
  | ~Some_vt(x0) => stream_vt_cons{a}(x0, aux(st))
end // end of [let]
)
//
} (* end of [stream_vt_unfold_opt] *)

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

implement
{x,y}(*tmp*)
cross_stream_vt_list
  (xs0, ys0) = let
//
fun
auxmain
(
  xs: stream_vt(x)
) : stream_vt(@(x, y)) = $ldelay
(
(
case+ !xs of
| ~stream_vt_nil
    () => stream_vt_nil()
| ~stream_vt_cons
    (x, xs) => !(auxmain2(x, xs, ys0))
)
,
(~xs) // called when the stream is freed
) (* end of [auxmain] *)
//
and
auxmain2
(
  x0: x
, xs: stream_vt(x), ys: List(y)
) : stream_vt(@(x, y)) = $ldelay
(
(
case+ ys of
| list_nil() => !(auxmain(xs))
| list_cons(y, ys) =>
    stream_vt_cons((x0, y), auxmain2(x0, xs, ys))
)
,
~(xs) // called when the stream is freed
) (* end of [auxmain2] *)
//
in
  auxmain(xs0)
end // end of [cross_stream_vt_list]

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

implement
{x,y}(*tmp*)
cross_stream_vt_list_vt
  (xs0, ys0) = let
//
val ys0 =
  $UN.castvwtp0{ptr}(ys0)
//
fun
auxmain
(
  xs: stream_vt(x)
) : stream_vt(@(x, y)) = $ldelay
(
(
case+ !xs of
| ~stream_vt_nil
    ((*void*)) => stream_vt_nil()
| ~stream_vt_cons(x, xs) =>
    !(auxmain2(x, xs, $UN.cast{List(y)}(ys0)))
)
,
(~xs; list_vt_free<y>($UN.castvwtp0{List_vt(y)}(ys0)))
) (* end of [auxmain] *)
//
and
auxmain2
(
  x0: x
, xs: stream_vt(x), ys: List(y)
) : stream_vt(@(x, y)) = $ldelay
(
(
case+ ys of
| list_nil() => !(auxmain(xs))
| list_cons(y, ys) =>
    stream_vt_cons((x0, y), auxmain2(x0, xs, ys))
)
,
(~xs; list_vt_free<y>($UN.castvwtp0{List_vt(y)}(ys0)))
) (* end of [auxmain2] *)
//
in
  auxmain(xs0)
end // end of [cross_stream_vt_list_vt]

(* ****** ****** *)
//
implement
{a}(*tmp*)
stream_vt_fprint
  (xs, out, n) = let
//
fun
loop1
(
  xs: stream_vt(a), i: int
) : void = (
//
case+ !xs of
| ~stream_vt_nil() => ()
| ~stream_vt_cons(x, xs) =>
  (
    (if i > 0 then stream_vt_fprint$sep<>(out)); fprint_val<a>(out, x); loop1(xs, i+1)
  ) (* end of [stream_vt_cons] *)
//
) (* end of [loop1] *)
//
fun
loop2
(
  xs: stream_vt(a), i: int
) : void = (
//
if (
i < n
) then (
//
case+ !xs of
| ~stream_vt_nil() => ()
| ~stream_vt_cons(x, xs) =>
  (
    (if i > 0 then stream_vt_fprint$sep<>(out)); fprint_val<a>(out, x); loop2(xs, i+1)
  ) (* end of [stream_vt_cons] *)
//
) else ~(xs) // end of [if]
//
)
(* end of [loop2] *)
//
val () =
  stream_vt_fprint$beg(out)
//
val () =
(
  if n < 0
    then loop1(xs, 0(*i*)) else loop2(xs, 0(*i*))
  // end of [val]
) : void // end of [val]
//
val () =
  stream_vt_fprint$end(out)
//
in
  // nothing
end // end of [stream_vt_fprint]
//
implement
{}(*tmp*)
stream_vt_fprint$beg(out) = fprint_string(out, "(")
implement
{}(*tmp*)
stream_vt_fprint$end(out) = fprint_string(out, ")")
implement
{}(*tmp*)
stream_vt_fprint$sep(out) = fprint_string(out, ", ")
//
(* ****** ****** *)

local
//
datavtype streamer
  (a:vt@ype+) = STREAMER of (stream_vt(a))
//
assume streamer_vtype (a:vt0p) = streamer (a)
//
in (* in-of-local *)

implement
{}(*tmp*)
streamer_vt_make (xs) = STREAMER (xs)

implement
{}(*tmp*)
streamer_vt_free
  (xser) = let val+~STREAMER(xs) = xser in ~xs end
// end of [streamer_free]

implement
{a}(*tmp*)
streamer_vt_eval_exn
  (xser) = let
//
val+@STREAMER(xs) = xser
//
in
//
case+ !xs of
| ~stream_vt_cons
    (x, xs2) =>
  (
    xs := xs2; fold@(xser); x
  ) (* end of [stream_vt_cons] *)
| ~stream_vt_nil
    ((*void*)) => let
    prval () =
     __assert (view@xs) where
    {
      extern
      praxi __assert{l:addr}(!ptr@l >> stream_vt(a)@l): void
    } (* end of [prval] *)
    prval () = fold@(xser)
  in
    $raise StreamSubscriptExn()
  end (* end of [stream_vt_nil] *)
//
end // end of [stream_eval_exn]

end // end of [local]

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

(* end of [stream_vt.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

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

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/array.atxt
** Time of generation: Fri Aug 18 03:30:03 2017
*)

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

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: Feburary, 2012 *)

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

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

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

macdef castvwtp_trans = $UN.castvwtp0 // former name

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

implement
{a}(*tmp*)
array_getref_at
  (A, i) = let
//
val p =
  ptr0_add_guint<a>(addr@(A), i) in $UN.cast{cPtr1(a)}(p)
//
end // end of [array_getref_at]

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

implement
{a}{tk}(*tmp*)
array_get_at_gint (A, i) = let
  val p = ptr0_add_gint<a>(addr@(A), i) in $UN.ptr0_get<a>(p)
end // end of [array_get_at_gint]
implement
{a}{tk}(*tmp*)
array_get_at_guint (A, i) = let
  val p = ptr0_add_guint<a>(addr@(A), i) in $UN.ptr0_get<a>(p)
end // end of [array_get_at_guint]

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

implement
{a}{tk}(*tmp*)
array_set_at_gint (A, i, x) = let
  val p = ptr0_add_gint<a>(addr@(A), i) in $UN.ptr0_set<a>(p, x)
end // end of [array_set_at_uint]
implement
{a}{tk}(*tmp*)
array_set_at_guint (A, i, x) = let
  val p = ptr0_add_guint<a>(addr@(A), i) in $UN.ptr0_set<a>(p, x)
end // end of [array_set_at_guint]

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

implement
{a}{tk}(*tmp*)
array_exch_at_gint (A, i, x) = let
  val p = ptr0_add_gint<a>(addr@(A), i) in $UN.ptr0_exch<a>(p, x)
end // end of [array_exch_at_gint]
implement
{a}{tk}(*tmp*)
array_exch_at_guint (A, i, x) = let
  val p = ptr0_add_guint<a>(addr@(A), i) in $UN.ptr0_exch<a>(p, x)
end // end of [array_exch_at_guint]

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

implement
{a}(*tmp*)
array_subreverse
  (A, i, j) = let
//
fun
loop
(
  p1: ptr, p2: ptr
) : void =
(
if
p1 < p2
then let
  val x = $UN.ptr0_get<a>(p1)
  val () =
  $UN.ptr0_set<a>(p1, $UN.ptr0_get<a>(p2))
  val () = $UN.ptr0_set<a>(p2, x)
in
  loop(ptr0_succ<a>(p1), ptr0_pred<a>(p2))
end // end of [then]
else () // end of [else]
) (* end of [loop] *)
//
val pA = addr@A
val pi = ptr_add<a>(pA, i)
val pj = ptr_add<a>(pA, j)
//
in
  $effmask_all(loop(pi, ptr0_pred<a>(pj)))
end // end of [array_subreverse]

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

implement
{a}(*tmp*)
array_interchange
  (A, i, j) = let
//
(*
val () =
  println! ("array_interchange")
*)
//
in
//
if i != j then let
  val p0 = addr@(A)
  val pi = ptr0_add_guint<a>(p0, i)
  val pj =
    g1ofg0_ptr(ptr0_add_guint<a>(p0, j))
  // end of [val]
  val (pf, fpf | pj) = $UN.ptr_vtake{a}(pj)
  val () = $UN.ptr0_exch<a>(pi, !pj)
  prval ((*returned*)) = fpf(pf)
in
  // nothing
end else () // end of [if]
//
end // end of [array_interchange]

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

implement
{a}(*tmp*)
array_subcirculate
  (A, i, j) = let
//
extern
fun
memmove
(
  dst: ptr, src: ptr, bsz: size_t
) :<!wrt> ptr = "mac#atspre_array_memmove"
//
in
//
if i < j then
{
//
val p0 =
  ptr_add<a>(addr@(A), i)
val p1 =
  ptr_add<a>(addr@(A), j)
//
val A1 = $UN.ptr0_get<a>(p1)
val _(*ptr*) = memmove (ptr_succ<a>(p0), p0, (j-i)*sizeof<a>)
val ((*void*)) = $UN.ptr0_set<a>(p0, A1)
//
} else if i > j then
{
//
val p0 =
  ptr_add<a>(addr@(A), j)
val p1 =
  ptr_add<a>(addr@(A), i)
//
val A0 = $UN.ptr0_get<a>(p0)
val _(*ptr*) = memmove (p0, ptr_succ<a>(p0), (i-j)*sizeof<a>)
val ((*void*)) = $UN.ptr0_set<a>(p1, A0)
//
} else ((*void*)) // end of [if]
//
end // end of [array_subcirculate]

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

implement
{a}(*tmp*)
array_ptr_takeout
  {l}{n}{i}(pf | p, i) = let
  prval(pf, fpf) =
    array_v_takeout{a}{l}{n}{i}(pf)
  // end of [prval]
in
  (pf, fpf | ptr1_add_guint<a>(p, i))
end // end of [array_ptr_takeout]

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

implement
{a}(*tmp*)
array_ptr_alloc
  {n}(asz) = let
//
val
[l:addr]
(
  pf, pfgc | p
) = malloc_gc (asz * sizeof<a>)
prval pf =
__assert(pf) where
{
extern praxi __assert
  (pf: b0ytes (n*sizeof(a)) @ l): array_v (a?, l, n)
// end of [__assert]
} // end of [where] // end of [prval]
//
in
  (pf, pfgc | p)
end // end of [array_ptr_alloc]

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

implement
{}(*tmp*)
array_ptr_free
  {a}{l}{n}
  (pf, pfgc | p) = let
//
prval pf =
__assert(pf) where
{
//
extern praxi __assert
  (pf: array_v (a?, l, n)): b0ytes (n*sizeof(a)) @ l
// end of [__assert]
} // end of [where] // end of [prval]
//
in
  mfree_gc(pf, pfgc | p)
end // end of [array_ptr_free]

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

implement
{a}(*tmp*)
array_ptr_tabulate
  (asz) = let
//
val
(
  pf, pfgc | p
) = array_ptr_alloc<a>(asz)
//
local
implement
{a2}(*tmp*)
array_initize$init
  (i, x) =
(
x :=
array_tabulate$fopr<a2>(i)
)
in (*in of [local]*)
//
val () = array_initize<a>(!p, asz)
//
end // end of [local]
//
in
  @(pf, pfgc | p)
end // end of [array_ptr_tabulate]

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

implement
{a}(*tmp*)
fprint_array_int
  (out, A, asz) = let
//
prval() = lemma_array_param(A)
//
in
  fprint_array_size (out, A, i2sz(asz))
end // end of [fprint_array_int]

implement
{a}(*tmp*)
fprint_array_size
  (out, A, asz) = let
//
typedef tenv = int
//
implement
array_foreach$fwork<a><tenv>
  (x, env) = let
  val n = env
  val () = if n > 0 then fprint_array$sep<>(out)
  val () = env := n + 1
in
  fprint_ref<a>(out, x)
end // end of [array_foreach$fwork]
//
var env: tenv = 0
val _(*n*) = array_foreach_env<a><tenv> (A, asz, env)
//
in
  // nothing
end // end of [fprint_array_size]

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

implement
{}(*tmp*)
fprint_array$sep(out) = fprint(out, ", ")

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

implement
{a}(*tmp*)
fprint_array_sep
  (out, A, asz, sep) = let
//
implement
fprint_array$sep<>(out) = fprint (out, sep)
//
in
  fprint_array<a>(out, A, asz)
end // end of [fprint_array_sep]

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

implement
{a}(*tmp*)
array_copy
  {n} (to, from, n) = let
//
val p_to = addr@(to) and p_from = addr@(from)
//
val _ =
$extfcall
(
  ptr, "atspre_array_memcpy", p_to, p_from, n*sizeof<a>
) (* end of [val] *)
//
extern
praxi __assert {l1,l2:addr}
(
  pf1: !array_v(a?, l1, n) >> array_v(a  , l1, n)
, pf2: !array_v(a , l2, n) >> array_v(a?!, l2, n)
) : void // end of [__assert]
//
prval() = __assert(view@(to), view@(from))
//
in
  // nothing
end // end of [array_copy]

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

implement
{a}(*tmp*)
array_copy_from_list
  (A, xs) = let
//
prval() = lemma_list_param(xs)
//
fun loop
  {l:addr}{n:nat} .<n>.
(
  pf: !array_v (a?, l, n) >> array_v (a, l, n)
| p0: ptr l, xs: list (a, n)
) :<!wrt> void = (
  case+ xs of
  | list_nil() => let
      prval () = (pf := array_v_unnil_nil(pf))
    in
      // nothing
    end // end of [list_nil]
  | list_cons(x, xs) => let
      prval
      (pf1, pf2) = array_v_uncons(pf)
      val () = !p0 := x
      val () = loop(pf2 | ptr1_succ<a>(p0), xs)
      prval () = (pf := array_v_cons(pf1, pf2))
    in
      // nothing
    end // end of [list_cons]
) (* end of [loop] *)
//
in
  loop(view@(A) | addr@(A), xs)
end // end of [array_copy_from_list]

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

implement
{a}(*tmp*)
array_copy_from_list_vt
  (A, xs) = let
//
prval() = lemma_list_vt_param(xs)
//
fun loop
  {l:addr}{n:nat} .<n>.
(
  pf: !array_v(a?, l, n)
        >> array_v(a, l, n)
| p0: ptr l, xs: list_vt (a, n)
) :<!wrt> void = (
  case+ xs of
  | ~list_vt_nil() => let
      prval () =
        (pf := array_v_unnil_nil(pf))
      // end of [prval]
    in
      // nothing
    end // end of [list_vt_nil]
  | ~list_vt_cons(x, xs) => let
      prval
      (pf1, pf2) = array_v_uncons(pf)
      val () = !p0 := x
      val () =
        loop(pf2 | ptr1_succ<a>(p0), xs)
      // end of [val]
      prval () = pf := array_v_cons(pf1, pf2)
    in
      // nothing
    end // end of [list_vt_cons]
) (* end of [loop] *)
//
in
  loop(view@(A) | addr@(A), xs)
end // end of [array_copy_from_list_vt]

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

implement
{a}(*tmp*)
array_copy_to_list_vt
  (A, n) = res where {
//
prval() = lemma_array_param(A)
//
fun
loop
{l:addr}{n:nat} .<n>.
(
  pf: !array_v (a, l, n) >> array_v (a?!, l, n)
| p0: ptr l, nz: size_t n, res: &ptr? >> list_vt (a, n)
) :<!wrt> void = (
//
if
nz > 0
then let
  prval
  (pf1, pf2) = array_v_uncons(pf)
  val () =
    res := list_vt_cons{a}{0}(!p0, _)
  // end of [val]
  val+list_vt_cons(_, res1) = res
  val () = loop(pf2 | ptr1_succ<a>(p0), pred(nz), res1)
  prval () = (pf := array_v_cons(pf1, pf2))
  prval () = fold@ (res)
in
  // nothing
end else let
  prval () =
    pf := array_v_unnil_nil(pf) in res := list_vt_nil(*void*)
  // end of [prval]
end // end of [if]
) (* end of [loop] *)
//
var res: ptr
val () = loop(view@(A) | addr@(A), n, res)
//
} // end of [array_copy_to_list_vt]

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

implement
{a}(*tmp*)
array_foreach
  (A, asz) = let
  var env: void = ()
in
  array_foreach_env<a><void> (A, asz, env)
end // end of [array_foreach]

implement
{a}{env}(*tmp*)
array_foreach_env
  {n0}(A, asz, env) = let
//
prval() = lemma_array_param(A)
//
fun
loop
{l:addr}
{n:nat | n <= n0} .<n>.
(
  pf: !array_v (a, l, n)
| p0: ptr l, nz: size_t n, env: &env
) : sizeLte(n0) = let
//
(*
val () =
println! ("array_foreach_env: loop")
*)
//
in
//
if
(nz > 0)
then let
  prval
  (
    pf1, pf2
  ) = array_v_uncons(pf)
  val cont =
    array_foreach$cont<a><env>(!p0, env)
  // end of [val]
in
  if cont then let
    val () =
      array_foreach$fwork<a><env>(!p0, env)
    // end of [val]
    val res =
      loop(pf2 | ptr1_succ<a>(p0), pred(nz), env)
    // end of [val]
    prval () = (pf := array_v_cons(pf1, pf2))
  in
    res
  end else let
    prval () = pf := array_v_cons(pf1, pf2) in (nz)
  end (* end of [if] *)
end else nz(*0*) // end of [if]
//
end // end of [loop]
//
val p0 = addr@(A)
//
val nz = loop(view@(A) | p0, asz, env)
//
in
  asz - nz
end // end of [array_foreach_env]

(* ****** ****** *)
//
implement
{a}{env}(*tmp*)
array_foreach$cont (x, env) = true
//
(*
implement
{a}{env}(*tmp*)
array_foreach$fwork (x, env) = ((*void*))
*)
//
(* ****** ****** *)

implement
{a}(*tmp*)
array_foreach_fun
  {n}{fe}
  (A, asz, fwork) = let
//
typedef
tfun =
  (!unit_v | &a, !ptr) -<fun,fe> void
// end of [typedef]
//
prval pfu = unit_v ()
//
var env: ptr = the_null_ptr
val fwork = $UN.cast{tfun}(fwork)
val ((*void*)) =
  array_foreach_funenv<a>(pfu | A, asz, fwork, env)
//
prval ((*freed*)) = unit_v_elim(pfu)
//
in
  // nothing
end // end of [array_foreach_fun]

implement
{a}(*tmp*)
array_foreach_cloref
  {n}{fe}
  (A, asz, fwork) = let
//
  viewdef v = unit_v
  typedef vt = (&a) -<cloref,fe> void
//
  fun app .<>.
    (pf: !v | x: &a, env: !vt):<fe> void = env (x)
  // end of [fun]
  var env = fwork
  prval pfu = unit_v ()
  val ((*void*)) =
    array_foreach_funenv<a>{v}{vt}(pfu | A, asz, app, env)
  // end of [val]
  prval ((*freed*)) = unit_v_elim(pfu)
in
  // nothing
end // end of [array_foreach_cloref]

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

implement
{a}(*tmp*)
array_foreach_funenv
  {v}{vt}
(
  pf | A, asz, f, env
) =
(
  array_foreach_funenv_tsz{a}{v}{vt}(pf | A, asz, sizeof<a>, f, env)
) (* end of [array_foreach_funenv] *)

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

implement
{a1,a2}(*tmp*)
array_foreach2
  (A1, A2, asz) = let
  var env: void = ()
in
  array_foreach2_env<a1,a2><void> (A1, A2, asz, env)
end // end of [array_foreach2]

implement
{a1,a2}{env}
array_foreach2_env
  {n0}
  (A1, A2, asz, env) = let
//
prval() = lemma_array_param(A1)
//
fun
loop
{l1,l2:addr}
{n:nat | n <= n0} .<n>.
(
  pf1: !array_v(a1, l1, n)
, pf2: !array_v(a2, l2, n)
| p1: ptr l1, p2: ptr l2, nz: size_t n, env: &env
) : sizeLte(n0) = let
//
(*
//
val () =
println! ("array_foreach2_env: loop")
//
*)
//
in
//
if
(nz > 0)
then let
  prval
  (pf11, pf12) = array_v_uncons(pf1)
  prval
  (pf21, pf22) = array_v_uncons(pf2)
  val cont =
    array_foreach2$cont<a1,a2><env>(!p1, !p2, env)
  // end of [val]
in
  if cont then let
    val () =
      array_foreach2$fwork<a1,a2><env>(!p1, !p2, env)
    val res =
      loop (
        pf12, pf22
      | ptr1_succ<a1>(p1), ptr1_succ<a2>(p2), pred(nz), env
      ) (* loop *)
    prval () = pf1 := array_v_cons(pf11, pf12)
    prval () = pf2 := array_v_cons(pf21, pf22)
  in
    res
  end else let
    prval () = pf1 := array_v_cons(pf11, pf12)
    prval () = pf2 := array_v_cons(pf21, pf22) in (nz)
  end (* end of [if] *)
end else nz(*0*)
//
end // end of [loop]
//
val nz = loop(view@(A1), view@(A2) | addr@(A1), addr@(A2), asz, env)
//
in
  asz - nz
end // end of [array_foreach2_env]

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

implement
{a1,a2}{env}
array_foreach2$cont (x1, x2, env) = true
(*
implement
{a1,a2}{env}
array_foreach2$fwork (x1, x2, env) = ((*void*))
*)

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

implement
{a}(*tmp*)
array_iforeach
  (A, asz) = let
  var env: void = ()
in
  array_iforeach_env<a><void> (A, asz, env)
end // end of [array_iforeach]

implement
{a}{env}(*tmp*)
array_iforeach_env
  {n0} (A, asz, env) = let
//
prval() = lemma_array_param(A)
//
fun
loop
{l:addr}
{n:nat | n <= n0} .<n>.
(
  pf: !array_v (a, l, n)
| p0: ptr l, nz: size_t n, i0: size_t, env: &env
) : sizeLte (n0) = let
//
(*
val () =
println! ("array_iforeach_env: loop")
*)
//
in
//
if
(nz > 0)
then let
  prval (
    pf1, pf2
  ) = array_v_uncons(pf)
  val cont =
    array_iforeach$cont<a><env>(i0, !p0, env)
  // end of [val
in
  if cont then let
    val () =
      array_iforeach$fwork<a><env>(i0, !p0, env)
    val res =
      loop(pf2 | ptr1_succ<a>(p0), pred(nz), succ(i0), env)
    prval () = pf := array_v_cons{a}(pf1, pf2)
  in
    res
  end else let
    prval () = pf := array_v_cons(pf1, pf2) in (nz)
  end (* end of [if] *)
end // end of [then]
else nz(*0*) // end of [else]
//
end // end of [loop]
//
val p0 = addr@(A)
val nz = loop(view@(A) | p0, asz, g0int2uint(0), env)
//
in
  asz - nz
end // end of [array_iforeach_env]

(* ****** ****** *)
//
implement
{a}{env}(*tmp*)
array_iforeach$cont (i, x, env) = true
(*
implement
{a}{env}(*tmp*)
array_iforeach$fwork (i, x, env) = ((*void*))
*)
//
(* ****** ****** *)

implement
{a}(*tmp*)
array_rforeach
  (A, asz) = let
  var env: void = ()
in
  array_rforeach_env<a><void> (A, asz, env)
end // end of [array_rforeach]

implement
{a}{env}(*tmp*)
array_rforeach_env
  {n0} (A, asz, env) = let
//
prval() = lemma_array_param(A)
//
fun
loop
{l:addr}
{n:nat | n <= n0} .<n>.
(
  pf: !array_v (a, l, n)
| pz: ptr (l+n*sizeof(a)), nz: size_t n, env: &env
) : sizeLte (n0) = let
//
(*
//
val () =
println! ("array_rforeach_env: loop")
//
*)
//
in
//
if
(nz > 0)
then let
  prval
  (
    pf1, pf2
  ) = array_v_unextend(pf)
  val p1 = ptr1_pred<a>(pz)
  val (pf2 | p1) = viewptr_match(pf2 | p1)
  val cont = array_rforeach$cont<a><env>(!p1, env)
in
  if cont then let
    val () =
    array_rforeach$fwork<a><env>(!p1, env)
    val res = loop(pf1 | p1, pred(nz), env)
    prval () = pf := array_v_extend(pf1, pf2)
  in
    res
  end else let
    prval () = pf := array_v_extend{a}(pf1, pf2) in nz
  end (* end of [if] *)
end else nz(*0*) // end of [if]
//
end // end of [loop]
//
val pz =
  ptr1_add_guint<a>(addr@(A), asz)
//
val n0 = loop(view@(A) | pz, asz, env)
//
in
  asz - n0
end // end of [array_rforeach_env]

(* ****** ****** *)
//
implement
{a}{env}(*tmp*)
array_rforeach$cont (x, env) = true
(*
implement
{a}{env}(*tmp*)
array_rforeach$fwork (x, env) = ((*void*))
*)
//
(* ****** ****** *)

implement
{a}(*tmp*)
array_initize
  (A, asz) = let
//
stadef V = array_v
//
fun loop
  {l:addr}{n:nat} .<n>.
(
  pf: !V (a?, l, n) >> V (a, l, n)
| p0: ptr l, nz: size_t n, i0: size_t
) : void =
(
if
(nz > 0)
then let
//
  prval
  (pf1, pf2) = array_v_uncons(pf)
//
  val () =
    array_initize$init<a>(i0, !p0)
  // end of [val]
  val () =
    loop(pf2 | ptr1_succ<a>(p0), pred(nz), succ(i0))
  // end of [val]
//
  prval () = pf := array_v_cons{a}(pf1, pf2)
//
in
  // nothing
end else let
  prval () = pf := array_v_unnil_nil(pf)
in
  // nothing
end // end of [if]
) (* end of [loop] *)
//
prval() = lemma_g1uint_param(asz)
//
in
  loop(view@ (A) | addr@(A), asz, g0int2uint(0))
end // end of [array_initize]

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

implement
{a}(*tmp*)
array_initize_elt
  (A, asz, elt) = let
//
implement
{a2}(*tmp*)
array_initize$init
  (i, xi) = xi := $UN.castvwtp0{a2}(elt)
//
in
  $effmask_all (array_initize<a>(A, asz))
end // end of [array_initize_elt]

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

implement
{a}(*tmp*)
array_initize_list
  {n} (A, asz, xs) = let
//
typedef list0 = listGte (a, 0)
typedef list1 = listGte (a, 1)
//
fun loop
(
  p0: ptr, p1: ptr, xs: list0
) : void = let
//
(*
//
val () =
println!
  ("array_initize_list: loop")
//
*)
//
in
//
if (
p0 < p1
) then let
  val xs =
    $UN.cast{list1}(xs)
  // end of [val]
  val+list_cons(x, xs) = xs
  val () =
    $UN.ptr0_set<a>(p0, x)
  // end of [val]
  val p0 = ptr_succ<a>(p0)
in
  loop(p0, p1, xs)
end else () // end of [if]
//
end // end of [loop]
//
prval() = lemma_list_param(xs)
//
val p0 = addr@(A)
val p1 = ptr_add<a>(p0, asz)
val () = $effmask_all(loop(p0, p1, xs))
//
prval() =
__assert(A) where
{
//
extern
praxi
__assert (A: &array(a?, n) >> array(a, n)): void
//
} (* end of [prval] *)
//
in
  // nothing
end // end of [array_initize_list]

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

implement
{a}(*tmp*)
array_initize_rlist
  {n} (A, asz, xs) = let
//
typedef list0 = listGte (a, 0)
typedef list1 = listGte (a, 1)
//
fun loop
(
  pz: ptr, p0: ptr, xs: list0
) : void = let
//
(*
//
val () =
println!
  ("array_initize_rlist: loop")
//
*)
//
in
//
if pz > p0 then let
  val xs =
    $UN.cast{list1}(xs)
  // end of [val]
  val+list_cons(x, xs) = xs
  val pz = ptr_pred<a>(pz)
  val () = $UN.ptr0_set<a>(pz, x)
in
  loop(pz, p0, xs)
end else () // end of [if]
//
end // end of [loop]
//
prval() = lemma_list_param(xs)
//
val p0 = addr@(A)
val pz = ptr_add<a>(p0, asz)
val () = $effmask_all(loop(pz, p0, xs))
//
prval() =
__assert(A) where
{
extern
praxi
__assert (A: &array(a?, n) >> array(a, n)): void
} (* end of [prval] *)
//
in
  // nothing
end // end of [array_initize_rlist]

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

implement
{a}(*tmp*)
array_initize_list_vt
  {n} (A, asz, xs) = let
//
vtypedef list0 = listGte_vt (a, 0)
vtypedef list1 = listGte_vt (a, 1)
//
fun loop
(
  p0: ptr, p1: ptr, xs: list0
) : void = let
//
(*
val () =
println!
  ("array_initize_list_vt: loop")
*)
//
in
//
if p0 < p1 then let
  val xs =
    $UN.castvwtp0{list1}(xs)
  // end of [val]
  val+~list_vt_cons(x, xs) = xs
  val () = $UN.ptr0_set<a>(p0, x)
  val p0 = ptr_succ<a>(p0)
in
  loop(p0, p1, xs)
end else let
  prval () = $UN.cast2void (xs) in (*nothing*)
end // end of [if]
//
end // end of [loop]
//
prval () = lemma_list_vt_param (xs)
//
val p0 = addr@(A)
val p1 = ptr_add<a>(p0, asz)
val () = $effmask_all(loop(p0, p1, xs))
//
prval() =
__assert(A) where
{
//
extern
praxi
__assert (A: &array(a?, n) >> array(a, n)): void
//
} (* end of [prval] *)
//
in
  // nothing
end // end of [array_initize_list_vt]

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

implement
{a}(*tmp*)
array_initize_rlist_vt
  {n} (A, asz, xs) = let
//
vtypedef list0 = listGte_vt (a, 0)
vtypedef list1 = listGte_vt (a, 1)
//
fun loop
(
  pz: ptr, p0: ptr, xs: list0
) : void = let
//
(*
val () =
println!
  ("array_initize_rlist_vt: loop")
*)
//
in
//
if pz > p0 then let
  val xs =
    $UN.castvwtp0{list1}(xs)
  // end of [val]
  val+~list_vt_cons(x, xs) = xs
  val pz = ptr_pred<a>(pz)
  val () = $UN.ptr0_set<a>(pz, x)
in
  loop(pz, p0, xs)
end else let
  prval () = $UN.cast2void (xs) in (*nothing*)
end // end of [if]
//
end // end of [loop]
//
prval() = lemma_list_vt_param(xs)
//
val p0 = addr@(A)
val pz = ptr_add<a>(p0, asz)
val () = $effmask_all(loop(pz, p0, xs))
//
prval() =
__assert(A) where
{
//
extern
praxi
__assert (A: &array(a?, n) >> array(a, n)): void
//
} (* end of [prval] *)
//
in
  // nothing
end // end of [array_initize_rlist_vt]

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

implement
{a}(*tmp*)
array_uninitize
  (A, asz) = let
//
fun loop
  {l:addr}{n:nat} .<n>.
(
  pf: !array_v(a, l, n)
        >> array_v(a?, l, n)
| p0: ptr l, nz: size_t n, i0: size_t
) : void = let
//
(*
val () =
println! ("array_uninitize: loop")
*)
//
in
//
if
(nz > 0)
then let
//
  prval
  (pf1, pf2) = array_v_uncons(pf)
//
  val () =
    array_uninitize$clear<a>(i0, !p0)
  val () =
    loop(pf2 | ptr_succ<a>(p0), pred(nz), succ(i0))
//
  prval () = (pf := array_v_cons(pf1, pf2))
//
in
  // nothing
end else let
  prval () = pf := array_v_unnil_nil{a,a?}(pf)
in
  // nothing
end // end of [if]
//
end // end of [loop]
//
prval() = lemma_array_param(A)
//
prval pf = view@ (A)
//
val () = loop(pf | addr@(A), asz, i2sz(0))
//
prval () = view@ (A) := pf
//
in
  // nothing  
end // end of [array_uninitize]

(* ****** ****** *)

implement
{a}{b}
array_mapto
  {n}(A, B, n) = let
//
val pa = addr@(A)
val pa2 = ptr_add<a>(pa, n)
val pb = addr@(B)
//
fun loop{la,lb:addr}
(
  pa: ptr la, pa2: ptr, pb: ptr lb
) : void =
(
if pa < pa2 then let
  val (pfa, fpfa | pa) = $UN.ptr_vtake{a}(pa)
  val (pfb, fpfb | pb) = $UN.ptr_vtake{b?}(pb)
  val () = array_mapto$fwork<a><b> (!pa, !pb)
  prval () = fpfa(pfa)
  prval () = fpfb($UN.castview0{(b?)@lb}(pfb))
in
  loop(ptr_succ<a>(pa), pa2, ptr_succ<b> (pb))
end (* end of [if] *)
)
//
val () = loop(pa, pa2, pb)
prval [lb:addr] EQADDR () = ptr_get_index (pb)
prval () = view@(B) := $UN.castview0{array_v (b, lb, n)}(view@(B))
//
in
  // nothing
end (* end of [array_mapto] *)

(* ****** ****** *)

implement
{a,b}{c}
array_map2to
  {n}(A, B, C, n) = let
//
val pa = addr@(A)
val pa2 = ptr_add<a>(pa, n)
val pb = addr@(B)
val pc = addr@(C)
//
fun loop{la,lb,lc:addr}
(
  pa: ptr la, pa2: ptr, pb: ptr lb, pc: ptr lc
) : void =
(
if pa < pa2 then let
  val (pfa, fpfa | pa) = $UN.ptr_vtake{a}(pa)
  val (pfb, fpfb | pb) = $UN.ptr_vtake{b}(pb)
  val (pfc, fpfc | pc) = $UN.ptr_vtake{c?}(pc)
  val () = array_map2to$fwork<a,b><c> (!pa, !pb, !pc)
  prval () = fpfa(pfa)
  prval () = fpfb(pfb)
  prval () = fpfc($UN.castview0{(c?)@lc}(pfc))
in
  loop(ptr_succ<a>(pa), pa2, ptr_succ<b> (pb), ptr_succ<c> (pc))
end (* end of [if] *)
)
//
val () = loop(pa, pa2, pb, pc)
//
prval [lc:addr] EQADDR() = ptr_get_index (pc)
prval () = view@(C) := $UN.castview0{array_v (c, lc, n)}(view@(C))
//
in
  // nothing
end (* end of [array_map2to] *)

(* ****** ****** *)

(*
implement
{a}(*tmp*)
array_bsearch
  (A, n) = $effmask_all let
//
val itr =
  $IT.giter_make_array(view@(A) | addr@(A), n)
// end of [val]
//
implement
$IT.giter_bsearch$ford<a>(x) = array_bsearch$ford<a>(x)
//
val () = $IT.giter_bsearch(itr, n)
//
val ofs = $IT.giter_get_fofs (itr)
//
val (pf | ()) = $IT.giter_free_array (itr)
//
prval((*returned*)) = view@ (A) := pf
//
in
  ofs
end // end of [array_bsearch]
*)

(* ****** ****** *)

implement
{a}(*tmp*)
array_permute
  (A, asz) = let
//
prval() = lemma_array_param(A)
//
fun
loop
{l:addr}{n:nat} .<n>.
(
  pf: !array_v(a, l, n) | p0: ptr l, nz: size_t n
) : void = let
//
(*
val () =
  println! ("array_permute: loop")
*)
//
in
//
if
(nz >= 2)
then let
  val i = array_permute$randint<>(nz)
  prval(pf1, pf2) = array_v_uncons(pf)
//
  val () =
  if i > 0 then
  $UN.ptr0_exch<a>
    (ptr0_add_guint<a>(p0, i), !p0)
  // end of [if]
  val () = loop(pf2 | ptr1_succ<a>(p0), pred(nz))
//
  prval((*returned*)) = pf := array_v_cons(pf1, pf2)
in
  // nothing
end else ((*void*)) // end of [if]
//
end // end of [loop]
//
in
  loop(view@ (A) | addr@(A), asz)
end // end of [array_permute]

(* ****** ****** *)

#include "./SHARE/array_bsearch.dats"
#include "./SHARE/array_quicksort.dats"

(* ****** ****** *)

(* end of [array.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

(* ****** ****** *)

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/array_prf.atxt
** Time of generation: Fri Aug 18 03:30:03 2017
*)

(* ****** ****** *)

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: Feburary, 2012 *)

(* ****** ****** *)

primplmnt
array_v_unnil_nil
  {a1,a2}(pf) = let
//
prval () =
  array_v_unnil{a1}(pf)
//
in
  array_v_nil{a2}((*void*))
//
end // end of [array_v_unnil]

(* ****** ****** *)

primplmnt
array_v_sing
  (pfat) =
(
//
array_v_cons(pfat, array_v_nil())
//
) (* end of [array_v_sing] *)

primplmnt
array_v_unsing
  (pfarr) = let
//
prval
(
  pf1at, pf2arr
) = array_v_uncons (pfarr)
//
prval () = array_v_unnil (pf2arr)
//
in
  pf1at
end // end of [array_v_unsing]

(* ****** ****** *)

primplmnt
array_v_split
  {a}(pf_arr) =
  split (pf_arr) where
{
//
prfun
split
  {l:addr} 
  {n,i:nat | i <= n} .<i>.
(
  pf_arr: array_v (a, l, n)
) : (
  array_v (a, l, i), array_v (a, l+i*sizeof(a), n-i)
) = (
//
sif
i > 0
then let
  prval (pf1elt, pf2arr) = array_v_uncons(pf_arr)
  prval (pf1arr_res, pf2arr_res) = split{..}{n-1,i-1}(pf2arr)
in
  (array_v_cons (pf1elt, pf1arr_res), pf2arr_res)
end // end of [then]
else let
  prval EQINT () =
    eqint_make{i,0}() in (array_v_nil{a}{l}((*void*)), pf_arr)
  // end of [prval]
end // end of [else]
//
) (* end of [split] *)
//
} (* end of [array_v_split] *)

(* ****** ****** *)

primplmnt
array_v_split_at
  {a}{l}{n}{i}(pf | i) = array_v_split{a}{l}{n}{i}(pf)
// end of [array_v_split_at]

(* ****** ****** *)

primplmnt
array_v_unsplit
  {a}(pf1arr, pf2arr) =
  unsplit (pf1arr, pf2arr) where
{
//
prval () = lemma_array_v_param (pf1arr)
prval () = lemma_array_v_param (pf2arr) 
//
prfun
unsplit
  {l:addr}
  {n1,n2:nat} .<n1>.
(
  pf1arr: array_v (a, l, n1)
, pf2arr: array_v (a, l+n1*sizeof(a), n2)
) : array_v (a, l, n1+n2) =
(
//
sif
n1 > 0
then let
  prval @(
    pf11elt, pf12arr
  ) = array_v_uncons (pf1arr)
  prval pf_arr_res = unsplit (pf12arr, pf2arr)
in
  array_v_cons (pf11elt, pf_arr_res)
end // end of [then]
else let
  prval
  EQINT () = eqint_make {n1,0} ()
  prval () = array_v_unnil (pf1arr) in pf2arr
end // end of [sif]
//
) (* end of [unsplit] *)
//
} (* end of [array_v_unsplit] *)

(* ****** ****** *)

primplmnt
array_v_extend
  {a}(pf1arr, pf2at) =
(
//
array_v_unsplit
(
  pf1arr, array_v_sing{a}(pf2at)
) // end of [array_v_unsplit]
//
) (* end of [array_v_extend] *)

primplmnt
array_v_unextend
  {a}{l}{n} (pfarr) = let
//
prval (pf1arr, pf2arr) =
  array_v_split{a}{l}{n}{n-1}(pfarr)
//
in
  (pf1arr, array_v_unsing{a}(pf2arr))
end // end of [array_v_unextend]

(* ****** ****** *)

primplmnt
array_v_takeout
  {a}{l}{n}{i} (pfarr) =
  takeout{..}{n}{i}(pfarr) where
{
//
prfun
takeout
  {l:addr}{n:int}
  {i:nat | i < n} .<i>.
(
  pfarr: array_v (a, l, n)
) : vtakeout (
  array_v (a, l, n), a@l+i*sizeof(a)
) = let
  prval @(pf1at, pf2arr) = array_v_uncons(pfarr)
in
  sif i > 0 then let
    prval (pfat, fpf) = takeout{..}{n-1}{i-1}(pf2arr)
  in
    (pfat, llam pfat =<prf> array_v_cons{a}(pf1at, fpf(pfat)))
  end else let
    prval EQINT () = eqint_make{i,0}((*void*))
  in
    (pf1at, llam pf1at =<prf> array_v_cons{a}(pf1at, pf2arr))
  end // end of [sif]
end // end of takeout]
//
} // end of [array_v_takeout]

(* ****** ****** *)

(* end of [array_prf.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

(* ****** ****** *)

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/arrayptr.atxt
** Time of generation: Fri Aug 18 03:30:03 2017
*)

(* ****** ****** *)

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: May, 2012 *)

(* ****** ****** *)

staload UN = "prelude/SATS/unsafe.sats"

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_make_elt
  (asz, elt) = let
//
val
(
  pf, pfgc | p
) = array_ptr_alloc<a>(asz)
//
val () = array_initize_elt<a>(!p, asz, elt)
//
in
  arrayptr_encode(pf, pfgc | p)
end // end of [arrayptr_make_elt]

(* ****** ****** *)

implement
{}(*tmp*)
arrayptr_make_intrange
  {l,r} (l, r) = let
//
val asz = g1int2uint (r-l)
val [A:addr] A =
  arrayptr_make_uninitized<int>(asz)
//
fun loop
  {n:nat} .<n>. (
  p: ptr, asz: size_t n, l: int
) :<!wrt> void = let
in
//
if asz > 0 then let
  val () = $UN.ptr0_set<int>(p, l)
in
  loop(ptr0_succ<int>(p), pred(asz), l+1)
end else () // end of [if]
//
end // end of [loop]
//
val () = loop(ptrcast(A), asz, l)
//
in
  $UN.castvwtp0{arrayptr(intBtw(l,r),A,r-l)}(A)
end // end of [arrayptr_make_intrange]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_make_list
  (asz, xs) = let
//
prval () = lemma_list_param (xs)
//
val (
  pf, pfgc | p
) = array_ptr_alloc<a>(i2sz(asz))
//
val () = array_initize_list<a>(!p, asz, xs)
//
in
  arrayptr_encode(pf, pfgc | p)
end // end of [arrayptr_make_list]

implement
{a}(*tmp*)
arrayptr_make_rlist
  (asz, xs) = let
//
prval () = lemma_list_param (xs)
//
val (
  pf, pfgc | p
) = array_ptr_alloc<a>(i2sz(asz))
//
val () = array_initize_rlist<a>(!p, asz, xs)
//
in
  arrayptr_encode(pf, pfgc | p)
end // end of [arrayptr_make_rlist]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_make_subarray
  {n}{st,ln}(A, st, ln) = let
//
val p1 =
ptr_add<a>($UN.cast2ptr(A), st)
val (
  pf1, fpf | p1
) = $UN.ptr_vtake{array(a,ln)}(p1)
//
val A2 =
arrayptr_make_uninitized<a>(ln)
val p2 = ptrcast (A2)
prval pf2 = arrayptr_takeout (A2)
//
val () = array_copy<a>(!p2, !p1, ln)
//
prval () = fpf (pf1)
prval () = arrayptr_addback (pf2 | A2)
//
in
  A2
end // end of [arrayptr_make_subarray]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_make_list_vt
  (asz, xs) = let
//
prval() = lemma_list_vt_param(xs)
//
val (
 pf, pfgc | p
) = array_ptr_alloc<a>(i2sz(asz))
//
val () =
array_initize_list_vt<a>(!p, asz, xs)
//
in
  arrayptr_encode(pf, pfgc | p)
end // end of [arrayptr_make_list_vt]

implement
{a}(*tmp*)
arrayptr_make_rlist_vt
  (asz, xs) = let
//
prval() = lemma_list_vt_param(xs)
//
val (
 pf, pfgc | p
) = array_ptr_alloc<a>(i2sz(asz))
//
val () = array_initize_rlist_vt<a>(!p, asz, xs)
//
in
  arrayptr_encode(pf, pfgc | p)
end // end of [arrayptr_make_rlist_vt]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_make_uninitized
  (asz) = let
in
  arrayptr_encode2(array_ptr_alloc<a>(asz))
end // end of [arrayptr_uninitize]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_imake_list
  (A, asz) = res where
{
//
val p = ptrcast(A)
prval pf = arrayptr_takeout (A)
val res = list_make_array (!p, asz)
prval () = arrayptr_addback (pf | A)
} // end of [arrayptr_imake_list]

(* ****** ****** *)

(*
implement
arrayptr_free = ATS_MFREE // HX: in arrayptr.cats
*)

(* ****** ****** *)

implement
{a}(*tmp*)
fprint_arrayptr
  (out, A, n) = () where
{
//
val p = ptrcast(A)
prval pf = arrayptr_takeout(A)
//
val () = fprint_array<a>(out, !p, n)
prval () = arrayptr_addback(pf | A)
//
} // end of [fprint_arrayptr]

(* ****** ****** *)

implement
{a}(*tmp*)
fprint_arrayptr_sep
  (out, A, n, sep) = () where
{
//
val p = ptrcast (A)
prval pf = arrayptr_takeout(A)
val () = fprint_array_sep<a>(out, !p, n, sep)
prval () = arrayptr_addback(pf | A)
//
} // end of [fprint_arrayptr_sep]

(* ****** ****** *)

implement
{a}{tk}
arrayptr_get_at_gint
  (A, i) = let
  val p = ptrcast(A) in
  $UN.ptr0_get<a>(ptr1_add_gint<a><tk>(p, i))
end // end of [arrayptr_get_at_gint]

implement
{a}{tk}
arrayptr_get_at_guint
  (A, i) = let
  val p = ptrcast(A) in
  $UN.ptr0_get<a>(ptr1_add_guint<a><tk>(p, i))
end // end of [arrayptr_get_at_guint]

(* ****** ****** *)

implement
{a}{tk}
arrayptr_set_at_gint
  (A, i, x) = let
  val p = ptrcast(A) in
  $UN.ptr0_set<a>(ptr1_add_gint<a><tk>(p, i), x)
end // end of [arrayptr_set_at_gint]

implement
{a}{tk}
arrayptr_set_at_guint
  (A, i, x) = let
  val p = ptrcast(A) in
  $UN.ptr0_set<a>(ptr1_add_guint<a><tk>(p, i), x)
end // end of [arrayptr_set_at_guint]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_interchange
  (A, i, j) = let
//
  val p = ptrcast (A)
  prval pfarr = arrayptr_takeout (A)
  val () = array_interchange (!p, i, j)
  prval () = arrayptr_addback (pfarr | A)
//
in
  // noting
end // end of [arrayptr_interchange]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_foreach
  (A, asz) = let
  var env: void = () in
  arrayptr_foreach_env<a><void>(A, asz, env)
end // end of [arrayptr_foreach]

implement
{a}{env}
arrayptr_foreach_env
  (A, asz, env) = res where {
//
val p = ptrcast (A)
prval pfarr = arrayptr_takeout(A)
//
val res =
array_foreach_env<a><env>(!p, asz, env)
prval () = arrayptr_addback{a}(pfarr | A)
//
} // end of [arrayptr_foreach_env]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_foreach_fun
  (A, asz, f) = let
//
val p = ptrcast(A)
prval pfarr = arrayptr_takeout(A)
//
val () = array_foreach_fun<a>(!p, asz, f)
prval () = arrayptr_addback{a}(pfarr | A)
//
in
  // nothing
end // end of [arrayptr_foreach_fun]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_foreach_funenv
  (pfv | A, asz, f, env) = let
//
val p = ptrcast (A)
prval pfarr = arrayptr_takeout(A)
//
val () =
array_foreach_funenv<a>(pfv | !p, asz, f, env)
prval () = arrayptr_addback{a}(pfarr | A)
//
in
  // nothing
end // end of [arrayptr_foreach_funenv]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_iforeach
  (A, asz) = let
  var env: void = () in
  arrayptr_iforeach_env<a><void>(A, asz, env)
end // end of [arrayptr_iforeach]

implement
{a}{env}
arrayptr_iforeach_env
  (A, asz, env) = res where {
//
val p = ptrcast (A)
prval pfarr = arrayptr_takeout (A)
//
val res =
array_iforeach_env<a><env>(!p, asz, env)
prval () = arrayptr_addback{a}(pfarr | A)
//
} // end of [arrayptr_iforeach_env]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_rforeach
  (A, asz) = let
  var env: void = () in
  arrayptr_rforeach_env<a><void>(A, asz, env)
end // end of [arrayptr_rforeach]

implement
{a}{env}
arrayptr_rforeach_env
  (A, asz, env) = res where {
//
val p = ptrcast(A)
prval pfarr = arrayptr_takeout(A)
//
val res =
array_rforeach_env<a><env>(!p, asz, env)
prval () = arrayptr_addback{a}(pfarr | A)
//
} // end of [arrayptr_rforeach_env]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_initize
  (A, asz) = () where {
//
val p = ptrcast(A)
prval pfarr = arrayptr_takeout(A)
//
val () = array_initize<a>(!p, asz)
prval () = arrayptr_addback{a}(pfarr | A)
//
} // end of [arrayptr_initize]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_uninitize
  (A, asz) = () where {
//
val p = ptrcast(A)
prval pfarr = arrayptr_takeout(A)
//
val () = array_uninitize<a>(!p, asz)
prval () = arrayptr_addback{a?}(pfarr | A)
//
} // end of [arrayptr_uninitize]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_freelin
  (A, asz) = let
//
val () = arrayptr_uninitize<a>(A, asz)
//
in
  arrayptr_free{a?}(A)
end // end of [arrayptr_freelin]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_tabulate
  (asz) =
  arrayptr_encode2(array_ptr_tabulate<a>(asz))
// end of [arrayptr_tabulate]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_tabulate_cloref
  {n} (asz, f) = let
//
implement(a2)
array_tabulate$fopr<a2>
  (i) = $UN.castvwtp0{a2}(f($UN.cast{sizeLt(n)}(i)))
//
in
  arrayptr_tabulate<a>(asz)
end // end of [arrayptr_tabulate_cloref]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayptr_quicksort
  (A, asz) = () where
{
//
val p = ptrcast(A)
prval pfarr = arrayptr_takeout(A)
//
val () = array_quicksort<a>(!p, asz)
prval () = arrayptr_addback{a}(pfarr | A)
//
} (* end of [arrayptr_quicksort] *)

(* ****** ****** *)

(* end of [arrayptr.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

(* ****** ****** *)

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/arrayref.atxt
** Time of generation: Fri Aug 18 03:30:03 2017
*)

(* ****** ****** *)

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: May, 2012 *)

(* ****** ****** *)

staload UN = "prelude/SATS/unsafe.sats"

(* ****** ****** *)

implement
{a}(*tmp*)
arrayref_make_elt(asz, x) =
  arrayptr_refize(arrayptr_make_elt<a>(asz, x))
// end of [arrayref_make_elt]

(* ****** ****** *)

implement
{}(*tmp*)
arrayref_make_intrange
  (l, r) =
(
arrayptr_refize{int}(arrayptr_make_intrange<>(l, r))
) (* arrayref_make_intrange *)

(* ****** ****** *)

implement
{a}(*tmp*)
arrayref_make_list(asz, xs) =
  arrayptr_refize(arrayptr_make_list<a>(asz, xs))
// end of [arrayref_make_list]

implement
{a}(*tmp*)
arrayref_make_rlist(asz, xs) =
  arrayptr_refize(arrayptr_make_rlist<a>(asz, xs))
// end of [arrayref_make_rlist]

(* ****** ****** *)
//
implement
{a}(*tmp*)
arrayref_head(A) = $UN.ptr0_get<a> (arrayref2ptr(A))
implement
{a}(*tmp*)
arrayref_tail{n}(A) =
$UN.cast{arrayref(a,n-1)}(ptr_succ<a>(arrayref2ptr(A)))
//
(* ****** ****** *)

implement
{a}{tk}(*tmp*)
arrayref_get_at_gint
  (A, i) = let
//
val (vbox pf | p) =
  arrayref_get_viewptr(A) in array_get_at_gint(!p, i)
end // end of [arrayref_get_at_gint]
implement
{a}{tk}(*tmp*)
arrayref_get_at_guint
  (A, i) = let
//
val (vbox pf | p) =
  arrayref_get_viewptr(A) in array_get_at_guint(!p, i)
end // end of [arrayref_get_at_guint]

(* ****** ****** *)

implement
{a}{tk}(*tmp*)
arrayref_set_at_gint
  (A, i, x) = let
//
val (vbox pf | p) =
  arrayref_get_viewptr(A) in array_set_at_gint(!p, i, x)
//
end // end of [arrayref_set_at_gint]
implement
{a}{tk}(*tmp*)
arrayref_set_at_guint
  (A, i, x) = let
//
val (vbox pf | p) =
  arrayref_get_viewptr(A) in array_set_at_guint(!p, i, x)
//
end // end of [arrayref_set_at_guint]

(* ****** ****** *)

implement
{a}{tk}(*tmp*)
arrayref_exch_at_gint
  (A, i, x) = let
//
val (vbox pf | p) =
  arrayref_get_viewptr(A) in array_exch_at_gint(!p, i, x)
//
end // end of [arrayref_exch_at_gint]
implement
{a}{tk}(*tmp*)
arrayref_exch_at_guint
  (A, i, x) = let
//
val (vbox pf | p) =
  arrayref_get_viewptr(A) in array_exch_at_guint(!p, i, x)
//
end // end of [arrayref_exch_at_guint]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayref_interchange
  (A, i, j) = let
//
val (vbox pf | p) =
  arrayref_get_viewptr(A) in array_interchange<a>(!p, i, j)
//
end // end of [arrayref_interchange]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayref_subcirculate
  (A, i, j) = let
//
val (vbox pf | p) =
  arrayref_get_viewptr(A) in array_subcirculate<a> (!p, i, j)
//
end // end of [arrayref_subcirculate]

(* ****** ****** *)

implement
{a}(*tmp*)
fprint_arrayref
  (out, A, n) = let
//
val
(vbox pf | p) = arrayref_get_viewptr(A)
//
in
  $effmask_ref(fprint_array<a>(out, !p, n))
end // end of [fprint_arrayref]

implement
{a}(*tmp*)
fprint_arrayref_sep
  (out, A, n, sep) = let
//
val
(vbox pf | p) = arrayref_get_viewptr(A)
//
in
  $effmask_ref(fprint_array_sep<a>(out, !p, n, sep))
end // end of [fprint_arrayref_sep]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayref_copy
  {n} (A, n) = let
//
val (pf, fpf | p) =
  $UN.ptr0_vtake{array(a,n)}(ptrcast(A))
//
val (pf2, pf2gc | p2) = array_ptr_alloc<a> (n)
val ((*void*)) = array_copy<a> (!p2, !p, n)
//
prval ((*void*)) = fpf (pf)
//
in
  $UN.castvwtp0{arrayptr(a,n)}((pf2, pf2gc | p2))
end // end of [arrayref_copy]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayref_tabulate
  (asz) = arrayptr_refize (arrayptr_tabulate<a> (asz))
// end of [arrayref_tabulate]

implement
{a}(*tmp*)
arrayref_tabulate_cloref
  (asz, f) = arrayptr_refize (arrayptr_tabulate_cloref<a> (asz, f))
// end of [arrayref_tabulate_cloref]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayref_foreach
  (A, asz) = let
  var env: void = ()
  in arrayref_foreach_env<a><void> (A, asz, env)
end // end of [arrayref_foreach]

implement
{a}{env}
arrayref_foreach_env
  (A, asz, env) = let
//
val
(vbox pf | p) = arrayref_get_viewptr(A)
//
in
  $effmask_ref(array_foreach_env<a><env>(!p, asz, env))
end // end of [arrayref_foreach_env]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayref_iforeach
  (A, asz) = let
  var env: void = () in
  arrayref_iforeach_env<a><void> (A, asz, env)
end // end of [arrayref_iforeach]

implement
{a}{env}
arrayref_iforeach_env
  (A, asz, env) = let
//
val
(vbox pf | p) = arrayref_get_viewptr(A)
//
in
//
$effmask_ref
  (array_iforeach_env<a><env>(!p, asz, env))
//
end // end of [arrayref_iforeach_env]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayref_rforeach
  (A, asz) = let
  var env: void = () in
  arrayref_rforeach_env<a><void>(A, asz, env)
end // end of [arrayref_rforeach]

implement
{a}{env}
arrayref_rforeach_env
  (A, asz, env) = let
//
val
(vbox pf | p) = arrayref_get_viewptr(A)
//
in
//
$effmask_ref
  (array_rforeach_env<a><env>(!p, asz, env))
//
end // end of [arrayref_rforeach_env]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayref_is_ordered
  (A, asz) = let
//
fun
loop
{i:nat}
(
  p0: ptr, i: size_t(i)
) : bool =
if
(i > 0)
then let
//
val p1 = ptr_succ<a>(p0)
//
val
(pf0,fpf0|p0) = $UN.ptr_vtake{a}(p0)
val
(pf1,fpf1|p1) = $UN.ptr_vtake{a}(p1)
//
val sgn = gcompare_ref_ref<a>(!p0, !p1)
//
prval ((*returned*)) = fpf0(pf0)
prval ((*returned*)) = fpf1(pf1)
//
in
//
if sgn <= 0
  then loop(p1, pred(i)) else false
//
end // end of [then]
else true // end of [else]
//
in
//
if (asz > 0)
  then loop(ptrcast(A), pred(asz)) else true
//
end // end of [arrayref_is_ordered]

(* ****** ****** *)

implement
{a}(*tmp*)
arrayref_quicksort
  (A, asz) = let
//
val
(vbox(pf) | p0) =
arrayref_get_viewptr{a}(A)
//
in
  $effmask_ref(array_quicksort<a>(!p0, asz))
end // end of [arrayref_quicksort]

implement
{a}(*tmp*)
arrayref_quicksort_stdlib
  (A, asz, cmp) = let
//
val
(vbox(pf) | p0) =
arrayref_get_viewptr{a}(A)
//
in
  $effmask_ref(array_quicksort_stdlib<a>(!p0, asz, cmp))
end // end of [arrayref_quicksort_stdlib]

(* ****** ****** *)

local

datatype
arrszref
(
  a:viewt@ype
) =
  {n:int}
  ARRSZREF of (arrayref(a, n), size_t(n))
// end of [arrszref]

assume
arrszref_vt0ype_type = arrszref

in (* in of [local] *)

implement
{}(*tmp*)
arrszref_make_arrpsz
  (psz) = let
//
var
asz: size_t // uninitized
//
val A =
arrpsz_get_ptrsize(psz, asz)
//
in
  ARRSZREF(arrayptr_refize(A), asz)
end // end of [arrszref_make_arrpsz]

(* ****** ****** *)
//
implement
{}(*tmp*)
arrszref_make_arrayref
  (A, asz) = ARRSZREF(A, asz)
//
(* ****** ****** *)

implement
{}(*tmp*)
arrszref_get_ref
  (ASZ) = let
//
val+
ARRSZREF(A, _) = ASZ in $UN.cast2Ptr1(A)
//
end // end of [arrszref_get_size]

(* ****** ****** *)

implement
{}(*tmp*)
arrszref_get_size
  (ASZ) = let
//
val+ARRSZREF(_, n) = ASZ in (n)
//
end // end of [arrszref_get_size]

(* ****** ****** *)

implement
{}(*tmp*)
arrszref_get_refsize
  (ASZ, nref) = let
//
val+ARRSZREF(A, n) = ASZ
//
prval() = lemma_arrayref_param(A)
//
in
  nref := n; A(*arrayref*)
end // end of [arrszref_get_refsize]

end // end of [local]

(* ****** ****** *)

implement
{a}(*tmp*)
arrszref_make_elt
  (n, x) = let
//
val n = g1ofg0_uint(n)
val A = arrayref_make_elt<a>(n, x)
//
in
  arrszref_make_arrayref{a}(A, n)
end // end of [arrszref_make_elt]

(* ****** ****** *)

implement
{a}(*tmp*)
arrszref_make_list
  (xs) = let
//
val n = list_length<a> (xs)
val A = arrayref_make_list<a>(n, xs)
//
prval () = lemma_list_param(xs)
//
in
  arrszref_make_arrayref{a}(A, i2sz(n))
end // end of [arrszref_make_list]

implement
{a}(*tmp*)
arrszref_make_rlist
  (xs) = let
//
prval () = lemma_list_param(xs)
//
val n = list_length<a> (xs)
val A = arrayref_make_rlist<a>(n, xs)
//
in
  arrszref_make_arrayref{a}(A, i2sz(n))
end // end of [arrszref_make_rlist]

(* ****** ****** *)

implement
{a}(*tmp*)
arrszref_get_at_size
  (ASZ, i) = $effmask_wrt let
//
var n: size_t
val A = arrszref_get_refsize<>(ASZ, n)
val i = g1ofg0_uint(i)
//
in
//
if n > i
then arrayref_get_at_guint(A, i)
else $raise ArraySubscriptExn((*void*))
//
end // end of [arrszref_get_at_size]

implement
{a}{tk}
arrszref_get_at_gint
  (ASZ, i) = let
in
//
if (
i >= 0
) then (
  arrszref_get_at_size (ASZ, g0i2u(i))
) else (
  $raise ArraySubscriptExn((* i < 0 *))
) // end of [if]
end // end of [arrszref_get_at_gint]

implement
{a}{tk}
arrszref_get_at_guint
  (ASZ, i) = let
in
  arrszref_get_at_size (ASZ, g0u2u(i))
end // end of [arrszref_get_at_guint]

(* ****** ****** *)

implement
{a}(*tmp*)
arrszref_set_at_size
  (ASZ, i, x) =
  $effmask_wrt let
//
var n: size_t
val A = arrszref_get_refsize<>(ASZ, n)
val i = g1ofg0_uint (i)
//
in
//
if n > i
then arrayref_set_at_guint (A, i, x)
else $raise ArraySubscriptExn((*void*))
//
end // end of [arrszref_set_at_size]

implement
{a}{tk}
arrszref_set_at_gint
  (ASZ, i, x) = let
in
//
if (
i >= 0
) then (
  arrszref_set_at_size (ASZ, g0i2u(i), x)
) else $raise ArraySubscriptExn((*i < 0*))
//
end // end of [arrszref_set_at_gint]

implement
{a}{tk}
arrszref_set_at_guint
  (ASZ, i, x) = let
in
  arrszref_set_at_size (ASZ, g0u2u(i), x)
end // end of [arrszref_set_at_guint]

(* ****** ****** *)

implement
{a}(*tmp*)
arrszref_exch_at_size
  (ASZ, i, x) =
  $effmask_wrt let
//
var n: size_t
val A = arrszref_get_refsize<>(ASZ, n)
val i = g1ofg0_uint (i)
//
in
//
if n > i
then arrayref_exch_at_guint (A, i, x)
else $raise ArraySubscriptExn((*void*))
// end of [if]
//
end // end of [arrszref_exch_at_size]

implement
{a}{tk}
arrszref_exch_at_gint
  (ASZ, i, x) = let
in
//
if (
i >= 0
) then (
  arrszref_exch_at_size (ASZ, g0i2u(i), x)
) else $raise ArraySubscriptExn((*i < 0*))
//
end // end of [arrszref_exch_at_gint]

implement
{a}{tk}
arrszref_exch_at_guint
  (ASZ, i, x) = let
in
  arrszref_exch_at_size (ASZ, g0u2u(i), x)
end // end of [arrszref_exch_at_guint]

(* ****** ****** *)

implement
{a}(*tmp*)
arrszref_interchange
(
  ASZ, i, j
) = $effmask_wrt let
//
var n: size_t
val A = arrszref_get_refsize<>(ASZ, n)
//
val i = g1ofg0_uint(i)
val j = g1ofg0_uint(j)
//
in
//
if n > i
then (
  if n > j
  then arrayref_interchange(A, i, j)
  else $raise ArraySubscriptExn((*void*))
) else $raise ArraySubscriptExn((*void*))
//
end // end of [arrszref_interchange]

(* ****** ****** *)

implement
{a}(*tmp*)
arrszref_subcirculate
(
  ASZ, i, j
) = $effmask_wrt let
//
var n: size_t
val A = arrszref_get_refsize<>(ASZ, n)
//
val i = g1ofg0_uint(i)
val j = g1ofg0_uint(j)
//
in
//
if n > i
then (
  if n > j
  then arrayref_subcirculate(A, i, j)
  else $raise ArraySubscriptExn((*void*))
) else $raise ArraySubscriptExn((*void*))
//
end // end of [arrszref_subcirculate]

(* ****** ****** *)

implement
{a}(*tmp*)
fprint_arrszref
  (out, ASZ) = let
//
var
asz: size_t
//
val A =
arrszref_get_refsize<>(ASZ, asz)
//
in
  fprint_arrayref<a>(out, A, asz)
end // end of [fprint_arrszref]

implement
{a}(*tmp*)
fprint_arrszref_sep
  (out, ASZ, sep) = let
//
var
asz: size_t
//
val A =
arrszref_get_refsize<>(ASZ, asz)
//
in
  fprint_arrayref_sep<a>(out, A, asz, sep)
end // end of [fprint_arrszref_sep]

(* ****** ****** *)
//
implement
{a}(*tmp*)
arrszref_tabulate(asz) = let
//
val
asz = g1ofg0_uint(asz)
val A = arrayref_tabulate<a>(asz) in arrszref_make_arrayref(A, asz)
//
end // end of [arrszref_tabulate]
//
implement
{a}(*tmp*)
arrszref_tabulate_cloref(asz, f) = let
  val A = arrayref_tabulate_cloref<a>(asz, f) in arrszref_make_arrayref(A, asz)
end // end of [arrszref_tabulate_cloref]
//
(* ****** ****** *)

implement
{a}(*tmp*)
streamize_arrszref_elt
  (ASZ) = let
//
var
asz: size_t
//
val A0 =
arrszref_get_refsize<>(ASZ, asz)
//
in
  streamize_arrayref_elt<a>(A0, asz)
end // end of [streamize_arrszref_elt]

(* ****** ****** *)

implement
{a}(*tmp*)
streamize_arrayref_elt
  (A0, asz) =
  auxmain(pa) where
{
//
val pa = arrayref2ptr(A0)
val pz = ptr_add<a>(pa, asz)
//
fun
auxmain
(
  pa: ptr
) : stream_vt(a) = $ldelay
(
if
(pa < pz)
then
stream_vt_cons
  ($UN.ptr0_get<a>(pa), auxmain(ptr_succ<a>(pa)))
else stream_vt_nil(*void*)
) (* end of [auxmain] *)
//
} (* end of [streamize_arrayref_elt] *)

(* ****** ****** *)

(* end of [arrayref.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

(* ****** ****** *)

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/matrix.atxt
** Time of generation: Fri Aug 18 03:30:04 2017
*)

(* ****** ****** *)

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: Feburary, 2012 *)

(* ****** ****** *)

staload UN = "prelude/SATS/unsafe.sats"

(* ****** ****** *)

implement{a}
matrix_getref_at_int
  (M, i, n, j) =
  $UN.cast{cPtr1(a)}(ptr_add<a> (addr@(M), i*n+j))
// end of [matrix_getref_at_int]

implement{a}
matrix_getref_at_size
  (M, i, n, j) =
  $UN.cast{cPtr1(a)}(ptr_add<a> (addr@(M), i*n+j))
// end of [matrix_getref_at_size]

(* ****** ****** *)

implement{a}
matrix_get_at_int
  (M, i, n, j) = $UN.cptr_get (matrix_getref_at_int (M, i, n, j))
// end of [matrix_get_at_int]

implement{a}
matrix_set_at_int
  (M, i, n, j, x) = $UN.cptr_set (matrix_getref_at_int (M, i, n, j), x)
// end of [matrix_set_at_int]

implement{a}
matrix_exch_at_int
  (M, i, n, j, x) = $UN.cptr_exch (matrix_getref_at_int (M, i, n, j), x)
// end of [matrix_exch_at_int]

(* ****** ****** *)

implement{a}
matrix_get_at_size
  (M, i, n, j) = $UN.cptr_get (matrix_getref_at_size (M, i, n, j))
// end of [matrix_get_at_size]

implement{a}
matrix_set_at_size
  (M, i, n, j, x) = $UN.cptr_set (matrix_getref_at_size (M, i, n, j), x)
// end of [matrix_set_at_size]

implement{a}
matrix_exch_at_size
  (M, i, n, j, x) = $UN.cptr_exch (matrix_getref_at_size (M, i, n, j), x)
// end of [matrix_exch_at_size]

(* ****** ****** *)

implement{a}
matrix_ptr_alloc
  (row, col) = let
//
val
(
  pfarr, pfgc | p
) = array_ptr_alloc<a> (row*col)
//
prval pfmat = array2matrix_v(pfarr)
//
in
  @(pfmat, pfgc | p)
end // end of [matrix_ptr_alloc]

(* ****** ****** *)

implement{}
matrix_ptr_free
  {a}(pfmat, pfgc | p) = let
//
prval
pfarr = matrix2array_v{a?}(pfmat)
//
in
  array_ptr_free (pfarr, pfgc | p)
end // end of [matrix_ptr_free]

(* ****** ****** *)

implement{a}
matrix_ptr_tabulate
  (row, col) = let
//
val (pf, pfgc | p) = matrix_ptr_alloc<a> (row, col)
//
implement
matrix_initize$init<a> (i, j, x) = x := matrix_tabulate$fopr<a> (i, j)
//
val () = matrix_initize<a> (!p, row, col)
//
in
  @(pf, pfgc | p)
end // end of [matrix_ptr_tabulate]

(* ****** ****** *)

implement{}
fprint_matrix$sep1 (out) = fprint (out, ", ")
implement{}
fprint_matrix$sep2 (out) = fprint (out, "; ")

implement{a}
fprint_matrix_int
  (out, M, m, n) = let
//
prval () = lemma_matrix_param (M)
//
in
  fprint_matrix_size (out, M, i2sz(m), i2sz(n))
end // end of [fprint_matrix_int]

implement{a}
fprint_matrix_size
  {m,n} (out, M, m, n) = let
//
implement
fprint_array$sep<> (out) = fprint_matrix$sep1 (out)
//
fun loop {l:addr}
(
  out: FILEref, p0: ptr l, m: size_t m, n: size_t n, i: size_t
) : void = let
in
//
if i < m then let
  val () =
  (
    if i > 0 then fprint_matrix$sep2 (out)
  ) : void // end of [val]
  val (
    pf, fpf | p0
  ) = $UN.ptr_vtake{array(a,n)}(p0)
  val () = fprint_array (out, !p0, n)
  prval () = fpf (pf)
in
  loop (out, ptr_add<a> (p0, n), m, n, succ(i))
end else () // end of [if]
//
end // end of [loop]
//
in
  loop (out, addr@ (M), m, n, i2sz(0))
end // end of [fprint_matrix_size]

(* ****** ****** *)

implement{a}
fprint_matrix_sep
(
  out, M, m, n, sep1, sep2
) = let
//
implement
fprint_matrix$sep1<>
  (out) = fprint (out, sep1)
implement
fprint_matrix$sep2<>
  (out) = fprint (out, sep2)
//
in
  fprint_matrix_size (out, M, m, n)
end // end of [fprint_matrix_sep]

(* ****** ****** *)
//
implement
{}(*tmp*)
matrix_foreach$rowsep() = ()
//
implement{a}
matrix_foreach
  (A, m, n) = let
//
var env: void = ()
//
in
  matrix_foreach_env<a><void> (A, m, n, env)
end // end of [matrix_foreach]
//
(*
implement
{a}{env}
matrix_foreach_env
  (A, m, n, env) = let
//
implement
array_foreach$cont<a><env>
  (x, env) = true
implement
array_foreach$fwork<a><env>
  (x, env) =
  matrix_foreach$fwork<a><env> (x, env)
//
val p = addr@(A)
prval pf = matrix2array_v{a}(view@(A))
//
val _(*mn*) = array_foreach_env<a> (!p, m*n, env)
prval ((*void*)) = view@(A) := array2matrix_v{a}(pf)
//
in
  // nothing
end // end of [matrix_foreach_env]
*)
//
implement
{a}{env}
matrix_foreach_env
  {m,n}(M, m, n, env) = let
//
prval () = lemma_matrix_param(M)
//
fnx
loop1
(
  p: ptr
, i: sizeLte(m), env: &env >> _
) : void = (
//
if
i < m
then loop2(p, i, i2sz(0), env) where
{
  val () =
    if i > 0 then matrix_foreach$rowsep()
  // end of [val]
}
//
) (* end of [loop1] *)
//
and
loop2
(
  p: ptr
, i: sizeLt(m), j: sizeLte(n), env: &env >> _
) : void = (
//
if
j < n
then let
//
val
(pf, fpf | p) =
$UN.ptr_vtake{a}(p)
//
val ((*void*)) =
  matrix_foreach$fwork<a><env>(!p, env)
//
prval ((*void*)) = fpf(pf)
//
in
  loop2(ptr_succ<a>(p), i, succ(j), env)
end // end of [then]
else loop1(p, succ(i), env) // end of [else]
//
) (* end of [loop2] *)
//
in
  loop1(addr@M, i2sz(0), env)
end // end of [matrix_foreach_env]
//
(* ****** ****** *)

implement{a}
matrix_foreachrow
  (A, m, n) = let
//
var env: void = ()
//
in
  matrix_foreachrow_env<a><void> (A, m, n, env)
end // end of [matrix_foreachrow]

implement
{a}{env}
matrix_foreachrow_env
  {m,n}(M, m, n, env) = let
//
prval () = lemma_matrix_param(M)
//
fun
loop
(
  p: ptr, i: sizeLte(m), env: &env >> _
) : void = (
//
if
i < m
then let
//
val
(pf, fpf | p) =
$UN.ptr_vtake{@[a][n]}(p)
val () =
  matrix_foreachrow$fwork<a><env>(!p, n, env)
prval ((*void*)) = fpf(pf)
//
in
  loop(ptr_add<a>(p, n), succ(i), env)
end // end of [then]
else () // end of [else]
//
) (* end of [loop] *)
//
in
  loop(addr@M, i2sz(0), env)
end // end of [matrix_foreachrow_env]

(* ****** ****** *)

implement{a}
matrix_initize
  (M, m, n) = let
//
infixl (/) %
#define % g0uint_mod
//
implement
array_initize$init<a>
  (ij, x) = let
in
  matrix_initize$init<a> (ij/n, ij%n, x)
end // end of [array_initize$init]
//
val p = addr@(M)
prval pf = matrix2array_v{a?}(view@(M))
val () = array_initize<a> (!p, m * n)
prval () = view@(M) := array2matrix_v{a}(pf)
//
in
  // nothing
end // end of [matrix_initize]

(* ****** ****** *)

implement{a}
matrix_uninitize
  (M, m, n) = let
//
infixl (/) %
#define % g0uint_mod
//
implement
array_uninitize$clear<a>
  (ij, x) = let
in
  matrix_uninitize$clear<a> (ij/n, ij%n, x)
end // end of [array_uninitize$clear]
//
val p = addr@(M)
prval pf = matrix2array_v{a}(view@(M))
val () = array_uninitize<a> (!p, m * n)
prval () = view@(M) := array2matrix_v{a?}(pf)
//
in
  // nothing
end // end of [matrix_uninitize]

(* ****** ****** *)

implement
{a}{b}
matrix_mapto
  {m,n} (A, B, m, n) = let
//
val pA = addr@(A)
val pB = addr@(B)
//
prval pfA = matrix2array_v{a}(view@(A))
prval pfB = matrix2array_v{b?}(view@(B))
//
local
//
implement
array_mapto$fwork<a><b>
  (x, y) = matrix_mapto$fwork<a><b> (x, y)
//
in (* in of [local] *)
//
val ((*void*)) = array_mapto<a><b> (!pA, !pB, m*n)
//
end // end of [local]
//
prval () = view@(A) := array2matrix_v {a}{..}{m,n} (pfA)
prval () = view@(B) := array2matrix_v {b}{..}{m,n} (pfB)
//
in
  // nothing
end (* end of [matrix_mapto] *)

(* ****** ****** *)

implement
{a,b}{c}
matrix_map2to
  {m,n} (A, B, C, m, n) = let
//
val pA = addr@(A)
val pB = addr@(B)
val pC = addr@(C)
//
prval pfA = matrix2array_v{a}(view@(A))
prval pfB = matrix2array_v{b}(view@(B))
prval pfC = matrix2array_v{c?}(view@(C))
//
local
//
implement
array_map2to$fwork<a,b><c>
  (x, y, z) = matrix_map2to$fwork<a,b><c> (x, y, z)
//
in (* in of [local] *)
//
val ((*void*)) = array_map2to<a,b><c> (!pA, !pB, !pC, m*n)
//
end // end of [local]
//
prval () = view@(A) := array2matrix_v {a}{..}{m,n} (pfA)
prval () = view@(B) := array2matrix_v {b}{..}{m,n} (pfB)
prval () = view@(C) := array2matrix_v {c}{..}{m,n} (pfC)
//
in
  // nothing
end (* end of [matrix_map2to] *)

(* ****** ****** *)

(* end of [matrix.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

(* ****** ****** *)

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/matrixptr.atxt
** Time of generation: Fri Aug 18 03:30:04 2017
*)

(* ****** ****** *)

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: Feburary, 2012 *)

(* ****** ****** *)

staload UN = "prelude/SATS/unsafe.sats"

(* ****** ****** *)

implement{}
arrayptr2matrixptr_int(A, m, n) = $UN.castvwtp0(A)
implement{}
arrayptr2matrixptr_size(A, m, n) = $UN.castvwtp0(A)

(* ****** ****** *)

implement{a}
matrixptr_make_elt
  {m, n} (m, n, x0) = let
  val mn = $UN.cast{Size}(m * n)
in
  $UN.castvwtp0{matrixptr(a,m,n)}(arrayptr_make_elt<a> (mn, x0))
end // end of [matrixptr_make_elt]

(* ****** ****** *)

implement{a}
matrixptr_get_at_int
  (M, i, n, j) = let
  val ij = $UN.cast{Size}(i * n + j)
in
  $UN.ptr0_get<a> (ptr_add<a> (ptrcast(M), ij))
end // end of [matrixptr_get_at_int]

implement{a}
matrixptr_get_at_size
  (M, i, n, j) = let
  val ij = $UN.cast{Size}(i * n + j)
in
  $UN.ptr0_get<a> (ptr_add<a> (ptrcast(M), ij))
end // end of [matrixptr_get_at_size]

(* ****** ****** *)

implement{a}
matrixptr_set_at_int
  (M, i, n, j, x) = let
  val ij = $UN.cast{Size}(i * n + j)
in
  $UN.ptr0_set<a> (ptr_add<a> (ptrcast(M), ij), x)
end // end of [matrixptr_set_at_int]

implement{a}
matrixptr_set_at_size
  (M, i, n, j, x) = let
  val ij = $UN.cast{Size}(i * n + j)
in
  $UN.ptr0_set<a> (ptr_add<a> (ptrcast(M), ij), x)
end // end of [matrixptr_set_at_size]

(* ****** ****** *)

implement{a}
matrixptr_exch_at_int
  (M, i, n, j, x) = let
  val ij = $UN.cast{Size}(i * n + j)
in
  $UN.ptr0_exch<a> (ptr_add<a> (ptrcast(M), ij), x)
end // end of [matrixptr_exch_at_int]

implement{a}
matrixptr_exch_at_size
  (M, i, n, j, x) = let
  val ij = $UN.cast{Size}(i * n + j)
in
  $UN.ptr0_exch<a> (ptr_add<a> (ptrcast(M), ij), x)
end // end of [matrixptr_exch_at_size]

(* ****** ****** *)

implement{a}
fprint_matrixptr
  {m,n} (out, M, m, n) = let
//
val p0 = ptrcast (M)
//
val (
  pf, fpf | p0
) = $UN.ptr_vtake {matrix(a,m,n)} (p0)
val () = fprint_matrix<a> (out, !p0, m, n)
prval () = fpf (pf)
//
in
  // nothing
end // end of [fprint_matrixptr]

(* ****** ****** *)

implement{a}
fprint_matrixptr_sep
(
  out, M, m, n, sep1, sep2
) = let
//
implement
fprint_matrix$sep1<> (out) = fprint_string (out, sep1)
implement
fprint_matrix$sep2<> (out) = fprint_string (out, sep2)
//
in
  fprint_matrixptr<a> (out, M, m, n)
end // end of [fprint_matrixptr_sep]

(* ****** ****** *)

(*
implement matrixptr_free = ATS_MFREE
*)

(* ****** ****** *)

implement{a}
matrixptr_foreach
  (M, m, n) = let
  var env: void = () in
  matrixptr_foreach_env<a><void> (M, m, n, env)
end // end of [matrixptr_foreach]

implement
{a}{env}
matrixptr_foreach_env
  (M, m, n, env) = res where
{
//
val p = ptrcast(M)
prval pfarr = matrixptr_takeout(M)
val res = matrix_foreach_env<a><env> (!p, m, n, env)
prval () = matrixptr_addback(pfarr | M)
//
} (* end of [matrixptr_foreach_env] *)

(* ****** ****** *)

implement
{a}(*tmp*)
matrixptr_initize
  (M, m, n) = () where
{
//
val p = ptrcast(M)
prval pfarr = matrixptr_takeout(M)
val () = matrix_initize<a>(!p, m, n)
prval () = matrixptr_addback(pfarr | M)
//
} (* end of [matrixptr_initize] *)

(* ****** ****** *)

implement
{a}(*tmp*)
matrixptr_uninitize
  (M, m, n) = () where
{
//
val p = ptrcast(M)
prval pfarr = matrixptr_takeout(M)
val () = matrix_uninitize<a>(!p, m, n)
prval () = matrixptr_addback(pfarr | M)
//
} (* end of [matrixptr_uninitize] *)

(* ****** ****** *)

implement
{a}(*tmp*)
matrixptr_freelin
  (M, m, n) = let
//
val () =
matrixptr_uninitize<a>(M, m, n)
//
in
  matrixptr_free{a?}(M)
end // end of [matrixptr_freelin]

(* ****** ****** *)

implement{a}
matrixptr_tabulate
  (nrow, ncol) =
(
  matrixptr_encode2(matrix_ptr_tabulate<a> (nrow, ncol))
) (* end of [matrixptr_tabulate] *)

(* ****** ****** *)

implement{a}
matrixptr_tabulate_cloref
  {m,n} (nrow, ncol, f) = let
//
implement(a2)
matrix_tabulate$fopr<a2> (i, j) =
  $UN.castvwtp0{a2}(f($UN.cast{sizeLt(m)}(i), $UN.cast{sizeLt(n)}(j)))
//
in
  matrixptr_tabulate<a> (nrow, ncol)
end // end of [matrixptr_tabulate_cloref]

(* ****** ****** *)

(* end of [matrixptr.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

(* ****** ****** *)

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/matrixref.atxt
** Time of generation: Fri Aug 18 03:30:04 2017
*)

(* ****** ****** *)

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: Feburary, 2012 *)

(* ****** ****** *)

staload UN = "prelude/SATS/unsafe.sats"

(* ****** ****** *)

implement{a}
matrixref_make_elt
  (nrow, ncol, x) =
  matrixptr_refize(matrixptr_make_elt<a> (nrow, ncol, x))
// end of [matrixref_make_elt]

(* ****** ****** *)

implement{a}
matrixref_get_at_size
  (A, i, n, j) = let
//
val
(
vbox pf | p
) = matrixref_get_viewptr (A)
//
in
  matrix_get_at_size (!p, i, n, j)
end // end of [matrixref_get_at_size]

(* ****** ****** *)
//
implement
{a}(*tmp*)
matrixref_get_at_int
  (M, i, n, j) =
  matrixref_get_at_size (M, i2sz(i), i2sz(n), i2sz(j))
//
(* ****** ****** *)

implement{a}
matrixref_set_at_size
  (A, i, n, j, x) = let
//
val
(
vbox pf | p
) = matrixref_get_viewptr (A)
//
in
  matrix_set_at_size (!p, i, n, j, x)
end // end of [matrixref_set_at_size]

(* ****** ****** *)
//
implement
{a}(*tmp*)
matrixref_set_at_int
  (M, i, n, j, x) =
  matrixref_set_at_size (M, i2sz(i), i2sz(n), i2sz(j), x)
//
(* ****** ****** *)

implement{a}
fprint_matrixref
  {m,n}
(
  out, M, nrow, ncol
) = {
//
val M =
$UN.castvwtp1{matrixptr(a, m, n)}(M)
//
val () = fprint_matrixptr<a> (out, M, nrow, ncol)
//
prval ((*void*)) = $UN.cast2void (M)
//
} (* end of [fprint_matrixref] *)

implement{a}
fprint_matrixref_sep
  {m,n}
(
  out, M, nrow, ncol, sep1, sep2
) = {
//
val M =
$UN.castvwtp1{matrixptr(a, m, n)}(M)
//
val () =
fprint_matrixptr_sep<a> (out, M, nrow, ncol, sep1, sep2)
//
prval ((*void*)) = $UN.cast2void (M)
//
} (* end of [fprint_matrixref_sep] *)

(* ****** ****** *)

implement
{a}(*tmp*)
matrixref_copy
  {m,n} (M, m, n) = let
//
val A = $UN.cast{arrayref(a,m*n)}(M)
//
in
  $UN.castvwtp0{matrixptr(a,m,n)}(arrayref_copy<a>(A, m*n))
end // end of [matrixref_copy]

(* ****** ****** *)

implement{a}
matrixref_tabulate
  (nrow, ncol) =
(
  matrixptr_refize (matrixptr_tabulate<a>(nrow, ncol))
) (* end of [matrixref_tabulate] *)

implement{a}
matrixref_tabulate_cloref
  (nrow, ncol, f) =
  matrixptr_refize (matrixptr_tabulate_cloref<a>(nrow, ncol, f))
// end of [matrixref_tabulate_cloref]

(* ****** ****** *)

implement{a}
matrixref_foreach
  (A, m, n) = let
//
var env: void = ()
//
in
  matrixref_foreach_env<a><void> (A, m, n, env)
end // end of [matrixref_foreach]

implement
{a}{env}
matrixref_foreach_env
  (A, m, n, env) = let
  val (vbox pf | p) = matrixref_get_viewptr (A)
in
  $effmask_ref (matrix_foreach_env<a><env> (!p, m, n, env))
end // end of [matrixref_foreach_env]

(* ****** ****** *)

implement
{a}(*tmp*)
matrixref_foreach_cloref
  (A, m, n, fwork) = let
//
implement
{a2}{env}
matrix_foreach$fwork
  (x, env) = let
  val (pf, fpf | p) = $UN.ptr_vtake{a}(addr@x)
  val ((*void*)) = fwork(!p)
  prval ((*void*)) = fpf(pf)
in
  // nothing
end // end of [matrix_foreach$work]
//
in
  matrixref_foreach<a>(A, m, n)
end // end of [matrixref_foreach_cloref]

(* ****** ****** *)

local
//
datatype
mtrxszref
(
  a:viewt@ype
) =
{m,n:int}
MTRXSZREF of
(
  matrixref(a, m, n)
, size_t(m), size_t(n)
) // end of [mtrxszref]
//
assume mtrxszref_vt0ype_type = mtrxszref
//
in (* in of [local] *)

implement{}
mtrxszref_make_matrixref
  (M, nrow, ncol) = MTRXSZREF (M, nrow, ncol)
// end of [mtrxszref_make_matrixref]

(* ****** ****** *)

implement{}
mtrxszref_get_ref (MSZ) = let
  val+MTRXSZREF (M, nrow, ncol) = MSZ in $UN.cast2Ptr1(M)
end // end of [mtrxszref_get_ref]

(* ****** ****** *)

implement{}
mtrxszref_get_nrow (MSZ) = let
  val+MTRXSZREF (M, nrow, ncol) = MSZ in nrow
end // end of [mtrxszref_get_nrow]

implement{}
mtrxszref_get_ncol (MSZ) = let
  val+MTRXSZREF (M, nrow, ncol) = MSZ in ncol
end // end of [mtrxszref_get_ncol]

(* ****** ****** *)

implement{}
mtrxszref_get_refsize
   (MSZ, nrow_r, ncol_r) = let
//
val+MTRXSZREF (M, nrow, ncol) = MSZ
//
prval ((*void*)) = lemma_matrixref_param (M)
//
in
  nrow_r := nrow; ncol_r := ncol; M(*matrixref*)
end // end of [mtrxszref_get_nrow]

end // end of [local]

(* ****** ****** *)

implement{a}
mtrxszref_make_elt
  (nrow, ncol, x) = let
//
val nrow = g1ofg0_uint (nrow)
val ncol = g1ofg0_uint (ncol)
val M =
  matrixref_make_elt<a> (nrow, ncol, x)
//
in
  mtrxszref_make_matrixref (M, nrow, ncol)
end // end of [mtrxszref_make_elt]

(* ****** ****** *)

implement{a}
mtrxszref_get_at_int
  (MSZ, i, j) = let
//
val i = g1ofg0_int(i)
and j = g1ofg0_int(j)
//
in
//
if
i >= 0
then (
//
if
j >= 0
then (
  mtrxszref_get_at_size(MSZ,i2sz(i),i2sz(j))
) else $raise MatrixSubscriptExn((* j < 0 *))
//
) else $raise MatrixSubscriptExn((* i < 0 *))
//
end // end of [mtrxszref_get_at_gint]

implement{a}
mtrxszref_get_at_size
  (MSZ, i, j) = let
//
var nrow: size_t
and ncol: size_t
//
val M =
$effmask_wrt (
  mtrxszref_get_refsize (MSZ, nrow, ncol)
) (* end of [val] *)
//
val i = g1ofg0_uint(i)
and j = g1ofg0_uint(j)
//
in
//
if
nrow > i
then (
//
if
ncol > j
then (
  matrixref_get_at_size (M, i, ncol, j)
) else $raise MatrixSubscriptExn((*void*))
//
) else $raise MatrixSubscriptExn((*void*))
//
end // end of [mtrxszref_get_at_size]

(* ****** ****** *)

implement{a}
mtrxszref_set_at_int
  (MSZ, i, j, x) = let
//
val i = g1ofg0_int(i)
and j = g1ofg0_int(j)
//
in
//
if
i >= 0
then (
//
if
j >= 0
then (
  mtrxszref_set_at_size(MSZ,i2sz(i),i2sz(j),x)
) else $raise MatrixSubscriptExn( (* j < 0 *) )
//
) else $raise MatrixSubscriptExn( (* i < 0 *) )
//
end // end of [mtrxszref_set_at_int]

implement{a}
mtrxszref_set_at_size
  (MSZ, i, j, x) = let
//
var nrow: size_t
and ncol: size_t
//
val M =
(
  mtrxszref_get_refsize (MSZ, nrow, ncol)
) (* end of [val] *)
//
val i = g1ofg0_uint (i)
and j = g1ofg0_uint (j)
//
in
//
if
nrow > i
then (
//
if
ncol > j
then (
  matrixref_set_at_size(M, i, ncol, j, x)
) else $raise MatrixSubscriptExn((*void*))
//
) else $raise MatrixSubscriptExn((*void*))
//
end // end of [mtrxszref_set_at_size]

(* ****** ****** *)

implement{a}
fprint_mtrxszref
  (out, MSZ) = let
//
var nrow: size_t
and ncol: size_t
val A =
  mtrxszref_get_refsize (MSZ, nrow, ncol)
//
in
  fprint_matrixref<a> (out, A, nrow, ncol)
end // end of [fprint_mtrxszref]

implement{a}
fprint_mtrxszref_sep
  (out, MSZ, sep1, sep2) = let
//
var nrow: size_t
and ncol: size_t
val A =
  mtrxszref_get_refsize (MSZ, nrow, ncol)
//
in
  fprint_matrixref_sep<a> (out, A, nrow, ncol, sep1, sep2)
end // end of [fprint_mtrxszref_sep]

(* ****** ****** *)

implement{a}
mtrxszref_foreach
  (A) = let
//
var env: void = ()
//
in
  mtrxszref_foreach_env<a><void> (A, env)
end // end of [mtrxszref_foreach]

implement
{a}{env}
mtrxszref_foreach_env
  (MSZ, env) = let
//
var nrow: size_t and ncol: size_t
//
val MAT = mtrxszref_get_refsize(MSZ, nrow, ncol)
//
in
  matrixref_foreach_env<a><env> (MAT, nrow, ncol, env)
end // end of [mtrxszref_foreach_env]

(* ****** ****** *)

implement
{a}(*tmp*)
mtrxszref_foreach_cloref
  (MSZ, fwork) = let
//
implement
{a2}{env}
matrix_foreach$fwork
  (x, env) = let
  val (pf, fpf | p) = $UN.ptr_vtake{a}(addr@x)
  val ((*void*)) = fwork(!p)
  prval ((*void*)) = fpf(pf)
in
  // nothing
end // end of [matrix_foreach$work]
//
in
  mtrxszref_foreach(MSZ)
end // end of [mtrxszref_foreach_cloref]

(* ****** ****** *)

implement{a}
mtrxszref_tabulate
  (nrow, ncol) = let
//
val nrow = g1ofg0_uint (nrow)
val ncol = g1ofg0_uint (ncol)
val M =
  matrixref_tabulate<a> (nrow, ncol)
//
in 
  mtrxszref_make_matrixref (M, nrow, ncol)
end // end of [mtrxszref_tabulate]

(* ****** ****** *)

implement{a}
mtrxszref_tabulate_cloref
(
  nrow, ncol, fclo
) = let
//
val M =
matrixref_tabulate_cloref<a>
(
  nrow, ncol, fclo
) (* end of [val] *)
//
in
//
mtrxszref_make_matrixref (M, nrow, ncol)
//
end // end of [mtrxszref_tabulate_cloref]

(* ****** ****** *)
//
implement
{a}(*tmp*)
streamize_mtrxszref_row_elt
  (MSZ) = let
//
var m: size_t and n: size_t
//
val M0 = mtrxszref_get_refsize(MSZ, m, n)
//
in
  streamize_matrixref_row_elt<a>(M0, m, n)
end // end of [streamize_mtrxszref_row_elt]
//
implement
{a}(*tmp*)
streamize_mtrxszref_col_elt
  (MSZ) = let
//
var m: size_t and n: size_t
//
val M0 = mtrxszref_get_refsize(MSZ, m, n)
//
in
  streamize_matrixref_col_elt<a>(M0, m, n)
end // end of [streamize_mtrxszref_col_elt]
//
(* ****** ****** *)
//
implement
{a}(*tmp*)
streamize_matrixref_row_elt
  {m,n}(M0, m, n) = let
//
val A0 = $UN.cast{arrayref(a,m*n)}(M0)
//
in
  streamize_arrayref_elt<a>(A0, m * n)
end // end of [streamize_matrixref_row_elt]
//
implement
{a}(*tmp*)
streamize_matrixref_col_elt
  {m,n}
  (M0, m, n) =
  auxmain(i2sz(0)) where
{
//
prval () = lemma_g1uint_param(m)
prval () = lemma_g1uint_param(n)
//
fun
auxmain
(
j : sizeLte(n)
) : stream_vt(a) =
(
if (j < n)
then auxmain2(j, i2sz(0)) else stream_vt_make_nil()
)
//
and
auxmain2
(
j : sizeLt(n),
i : sizeLte(m)
) : stream_vt(a) = $ldelay
(
if
(i < m)
then
stream_vt_cons{a}
  (matrixref_get_at<a>(M0, i, n, j), auxmain2(j, i+1))
else !(auxmain(j+1))
) (* end of [auxmain2] *)
//
} (* end of [streamize_matrixref_col_elt] *)
//
(* ****** ****** *)
//
(* end of [matrixref.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

(* ****** ****** *)

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/gprint.atxt
** Time of generation: Fri Aug 18 03:30:04 2017
*)

(* ****** ****** *)

(* Author: Hongwei Xi *)
(* Authoremail: hwxi AT cs DOT bu DOT edu *)
(* Start time: August, 2012 *)

(* ****** ****** *)

implement
{}(*tmp*)
gprint$out() = stdout_ref

(* ****** ****** *)

implement
{}(*tmp*)
gprint_flush() =
fileref_flush(gprint$out<>())

(* ****** ****** *)

implement
{}(*tmp*)
gprint_newline() = let
//
val
out = gprint$out<>() in fprint_newline(out)
//
end // end of [gprint_newline]

(* ****** ****** *)

implement
{a}(*tmp*)
gprint_val(x) = let
//
val
out = gprint$out<>() in fprint_val<a>(out, x)
//
end // end of [gprint_val]

(* ****** ****** *)

implement
{a}(*tmp*)
gprint_ref(x) = let
//
val
out = gprint$out<>() in fprint_ref<a>(out, x)
//
end // end of [gprint_ref]

(* ****** ****** *)
//
implement
{}(*tmp*)
gprint_int(x) =
  fprint_val<int>(gprint$out<>(), x)
implement
{}(*tmp*)
gprint_bool(x) =
  fprint_val<bool> (gprint$out<>(), x)
implement
{}(*tmp*)
gprint_char(x) =
  fprint_val<char>(gprint$out<>(), x)
implement
{}(*tmp*)
gprint_float(x) =
  fprint_val<float>(gprint$out<>(), x)
implement
{}(*tmp*)
gprint_double(x) =
  fprint_val<double>(gprint$out<>(), x)
implement
{}(*tmp*)
gprint_string(x) =
  fprint_val<string>(gprint$out<>(), x)
//
implement
gprint_val<int>(x) = gprint_int(x)
implement
gprint_val<char>(x) = gprint_char(x)
implement
gprint_val<float>(x) = gprint_float(x)
implement
gprint_val<double>(x) = gprint_double(x)
implement
gprint_val<string>(x) = gprint_string(x)
//
(* ****** ****** *)
//
implement
{}(*tmp*)
gprint_list$beg() = gprint_string "("
implement
{}(*tmp*)
gprint_list$end() = gprint_string ")"
implement
{}(*tmp*)
gprint_list$sep() = gprint_string ", "
//
(* ****** ****** *)
//
implement
{a}(*tmp*)
gprint_list
  (xs) = let
//
typedef tenv = int
//
implement
list_foreach$fwork<a><tenv>
  (x, env) = let
  val () =
  if env > 0
    then gprint_list$sep<>()
  // end of [if]
  val () = env := succ (env)
in
  gprint_val<a>(x)
end // end of [list_foreach$fwork]
//
var env: tenv = 0
val () = gprint_list$beg<>()
val () = list_foreach_env<a><tenv>(xs, env)
val () = gprint_list$end<>()
//
in
  // nothing
end // end of [gprint_list]
//
implement
(a)(*tmp*)
gprint_val<List(a)>(xs) = gprint_list<a>(xs)
//
(* ****** ****** *)
//
implement
{}(*tmp*)
gprint_listlist$beg1() = gprint_string "("
implement
{}(*tmp*)
gprint_listlist$end1() = gprint_string ")"
implement
{}(*tmp*)
gprint_listlist$sep1() = gprint_string ", "
//
implement
{}(*tmp*)
gprint_listlist$beg2() = gprint_string "("
implement
{}(*tmp*)
gprint_listlist$end2() = gprint_string ")"
implement
{}(*tmp*)
gprint_listlist$sep2() = gprint_string ", "
//
(* ****** ****** *)
//
implement
{a}(*tmp*)
gprint_listlist
  (xss) = let
//
typedef xs = List(a)
//
implement
gprint_val<xs>(xs) = let
//
implement
gprint_list$beg<>() =
  gprint_listlist$beg2<>()
implement
gprint_list$end<>() =
  gprint_listlist$end2<>()
implement
gprint_list$sep<>() =
  gprint_listlist$sep2<>()
//
in
  gprint_list<a>(xs)
end // end of [gprint_val]
//
implement
gprint_list$beg<>() =
  gprint_listlist$beg1<>()
implement
gprint_list$end<>() =
  gprint_listlist$end1<>()
implement
gprint_list$sep<>() =
  gprint_listlist$sep1<>()
//
in
  gprint_list<xs>(xss)
end // end of [gprint_listlist]
//
(* ****** ****** *)
//
implement
{}(*tmp*)
gprint_array$beg() = gprint_string "("
implement
{}(*tmp*)
gprint_array$end() = gprint_string ")"
implement
{}(*tmp*)
gprint_array$sep() = gprint_string ", "
//
(* ****** ****** *)

implement
{a}(*tmp*)
gprint_array
  (A, n) = () where
{
//
typedef tenv = size_t
//
implement
(env)(*tmp*)
array_iforeach$fwork<a><env>
  (i, x, env) =
  gprint_ref<a>(x) where
{
  val () =
  if i > 0
    then gprint_array$sep<>()
  // end of [if]
} (* array_iforeach$fwork *)
//
var env: void = ()
//
val () = gprint_array$beg<>()
val
_(*asz*) = array_iforeach<a>(A, n)
val () = gprint_array$end<>()
//
} (* end of [gprint_array] *)

(* ****** ****** *)

implement
{a}(*tmp*)
gprint_arrayptr
  (A, n) = () where
{
//
val p = ptrcast(A)
//
prval pf = arrayptr_takeout(A)
//
val () = gprint_array<a>(!p, n)
//
prval () = arrayptr_addback{a}(pf | A)
//
} (* end of [gprint_arrayptr] *)

(* ****** ****** *)

implement
{a}(*tmp*)
gprint_arrayref
  (A, n) = let
//
val (vbox pf | p) =
  arrayref_get_viewptr(A)
//
in
  $effmask_ref(gprint_array<a>(!p, n))
end // end of [gprint_arrayref]

(* ****** ****** *)

implement
{a}(*tmp*)
gprint_arrszref
  (ASZ) = () where {
//
var n: size_t
val A =
  arrszref_get_refsize<>(ASZ, n)
//
val () = gprint_arrayref<a>(A, n)
//
} (* end of [gprint_arrszref] *)

(* ****** ****** *)

(* end of [gprint.dats] *)
(***********************************************************************)
(*                                                                     *)
(*                         Applied Type System                         *)
(*                                                                     *)
(***********************************************************************)

(*
** ATS/Postiats - Unleashing the Potential of Types!
** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc.
** All rights reserved
**
** ATS is free software;  you can  redistribute it and/or modify it under
** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
** Free Software Foundation; either version 3, or (at  your  option)  any
** later version.
**
** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
** for more details.
**
** You  should  have  received  a  copy of the GNU General Public License
** along  with  ATS;  see the  file COPYING.  If not, please write to the
** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
** 02110-1301, USA.
*)

(* ****** ****** *)

(*
** Source:
** $PATSHOME/prelude/DATS/CODEGEN/tostring.atxt
** Time of generation: Fri Aug 18 03:30:04 2017
*)

(* ****** ****** *)

(* Author: Hongwei Xi *)
(* Authoremail: hwxiATgmailDOTcom *)
(* Start time: April, 2015 *)

(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
implement
{}(*tmp*)
tostring_int(i) = 
$effmask_wrt
(
  strptr2string(tostrptr_int(i))
)
implement
{}(*tmp*)
tostrptr_int(i) = let
//
#define BSZ 32
//
typedef
cstring = $extype"atstype_string"
//
var buf = @[byte][BSZ]()
val bufp = $UN.cast{cstring}(addr@buf)
//
val _(*int*) =
  $extfcall(ssize_t, "snprintf", bufp, BSZ, "%i", i)
//
in
//
$UN.castvwtp0{Strptr1}(string0_copy($UN.cast{string}(bufp)))
//
end // end of [tostrptr_int]
//
implement
tostring_val<int> = tostring_int
implement
tostrptr_val<int> = tostrptr_int
//
(* ****** ****** *)
//
implement
tostrptr_val<lint> = g0int2string_lint
implement
tostrptr_val<llint> = g0int2string_llint
//
(* ****** ****** *)
//
implement
{}(*tmp*)
tostring_uint(u) = 
$effmask_wrt
(
  strptr2string(tostrptr_uint(u))
)
implement
{}(*tmp*)
tostrptr_uint(u) = let
//
#define BSZ 32
//
typedef
cstring = $extype"atstype_string"
//
var buf = @[byte][BSZ]()
val bufp = $UN.cast{cstring}(addr@buf)
//
val _(*int*) =
  $extfcall(ssize_t, "snprintf", bufp, BSZ, "%u", u)
//
in
//
$UN.castvwtp0{Strptr1}(string0_copy($UN.cast{string}(bufp)))
//
end // end of [tostrptr_uint]
//
implement
tostring_val<uint> = tostring_uint
implement
tostrptr_val<uint> = tostrptr_uint
//
(* ****** ****** *)
//
implement
{}(*tmp*)
tostring_bool(b) = bool2string(b)
implement
{}(*tmp*)
tostrptr_bool(b) = string0_copy(bool2string(b))
//
implement
tostring_val<bool> = tostring_bool
implement
tostrptr_val<bool> = tostrptr_bool
//
(* ****** ****** *)
//
implement
{}(*tmp*)
tostring_char(c) =
$effmask_wrt
(
  strptr2string(char2strptr(c))
)
//
implement
{}(*tmp*)
tostrptr_char(c) = char2strptr(c)
//
implement
tostring_val<char> = tostring_char
implement
tostrptr_val<char> = tostrptr_char
//
(* ****** ****** *)

implement
{}(*tmp*)
tostring_double(i) = 
$effmask_wrt
(
  strptr2string(tostrptr_double(i))
)
implement
{}(*tmp*)
tostrptr_double(x) = let
//
#define BSZ 32
//
typedef
cstring = $extype"atstype_string"
//
var buf = @[byte][BSZ]()
val bufp = $UN.cast{cstring}(addr@buf)
//
val _(*int*) =
  $extfcall(ssize_t, "snprintf", bufp, BSZ, "%.6f", x)
//
in
//
$UN.castvwtp0{Strptr1}(string0_copy($UN.cast{string}(bufp)))
//
end // end of [tostrptr_double]
//
implement
tostring_val<double> = tostring_double
implement
tostrptr_val<double> = tostrptr_double
//
(* ****** ****** *)

implement
{a}(*tmp*)
tostrptr_list(xs) = let
//
fun
loop
(
  i: int
, xs: List(a)
, res: List0_vt(Strptr1)
) : List0_vt(Strptr1) =
(
case+ xs of
| list_nil
    ((*void*)) => res
| list_cons
    (x, xs) => let
    val res1 = 
    (
      if i > 0
        then let
          val sep =
            tostrptr_list$sep<> ()
          // end of [val]
          val sep = string0_copy (sep)
        in
          list_vt_cons (sep, res)
        end // end of [then]
        else res // end of [else]
    ) : List0_vt(Strptr1)
    val xrep = tostrptr_val<a> (x)
    val res2 = list_vt_cons (xrep, res1)
  in
    loop (i+1, xs, res2)
  end // end of [list_cons]
)
//
val res = list_vt_nil ()
//
val _beg =
  tostrptr_list$beg<> ()
val _beg = string0_copy(_beg)
val res = list_vt_cons (_beg, res)
//
val res = loop (0, xs, res)
//
val _end =
  tostrptr_list$end<> ()
val _end = string0_copy(_end)      
val res = list_vt_cons (_end, res)
//
val res = list_vt_reverse<Strptr1> (res)
//
in
//
$UN.castvwtp0{Strptr1}(strptrlst_concat(res))
//
end // end of [tostrptr_list]

(* ****** ****** *)
//
implement{} tostrptr_list$beg() = ""
implement{} tostrptr_list$end() = ""
implement{} tostrptr_list$sep() = ""
//
(* ****** ****** *)
//
implement(a)
tostrptr_val<List(a)>
  (xs0) = $effmask_all (tostrptr_list<a> (xs0))
//
(* ****** ****** *)

implement
{a}(*tmp*)
tostrptr_array
  (A, n) = let
//
prval() =
lemma_g1uint_param(n)
//
fun
loop
{n:nat} .<n>.
(
  i: int
, p: ptr, n: size_t(n)
, res: List0_vt(Strptr1)
) : List0_vt(Strptr1) =
(
if
(n > 0)
then let
//
  val res1 = 
  (
    if i > 0
      then let
        val sep =
          tostrptr_array$sep<>()
        // end of [val]
        val sep = string0_copy(sep)
      in
        list_vt_cons(sep, res)
      end // end of [then]
      else res // end of [else]
  ) : List0_vt(Strptr1)
//
  val
  (pf, fpf | p) =
    $UN.ptr_vtake{a}(p)
  // end of [val]
  val xrep = tostrptr_ref<a>(!p)
  prval ((*returned*)) = fpf(pf)
//
  val res2 = list_vt_cons(xrep, res1)
//
in
  loop (i+1, ptr_succ<a>(p), pred(n), res2)
end // end of [then]
else res // end of [else]
//
) (* end of [loop] *)
//
val res = list_vt_nil()
//
val
_beg =
tostrptr_array$beg<>()
val
_beg = string0_copy<>(_beg)
//
val res = list_vt_cons(_beg, res)
val res = loop(0, addr@A, n, res)
//
val
_end =
tostrptr_array$end<>()
val
_end = string0_copy<>(_end)
//
val res = list_vt_cons(_end, res)
val res = list_vt_reverse<Strptr1>(res)
//
in
//
$UN.castvwtp0{Strptr1}(strptrlst_concat(res))
//
end // end of [tostrptr_array]

(* ****** ****** *)
//
implement{}
tostrptr_array$beg() = "" // HX: default
implement{}
tostrptr_array$end() = "" // HX: default
implement{}
tostrptr_array$sep() = "" // HX: default
//
(* ****** ****** *)

implement
{a}(*tmp*)
tostrptr_arrayref
  (A, n) = let
//
val (vbox pf | p) =
  arrayref_get_viewptr(A)
//
in
//
$effmask_ref(tostrptr_array<a>(!p, n))
//
end // end of [tostrptr_arrayref]

(* ****** ****** *)

implement
{a}(*tmp*)
tostrptr_arrszref
  (ASZ) = let
//
var asz: size_t
//
in
  tostrptr_arrayref<a>(arrszref_get_refsize<>(ASZ, asz), asz)
end // end of [tostrptr_arrszref]

(* ****** ****** *)

(* end of [tostring.dats] *)