(***********************************************************************) (* *) (* 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-2017-11-07: // abstype types_nil abstype types_cons(vt@ype+, type+) (* stacst types_nil : types stacst types_cons : (vt@ype+, types+) -> types *) // (* ****** ****** *) // // 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:vt@ype): int = sizeof_t0ype_int(a?) // (* ****** ****** *) sortdef nat = { i:int | i >= 0 } 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 pos = { i:int | i > 0 } // positive ints sortdef neg = { i:int | i < 0 } // negative ints sortdef npos = { i:int | i <= 0 } // non-positive ints sortdef nneg = { i:int | i >= 0 } // non-negative ints (* ****** ****** *) sortdef sgn = { i:int | ~1 <= i; i <= 1 } (* ****** ****** *) sortdef igz = { i:int | i > 0 } sortdef igez = { i:int | i >= 0 } sortdef ilez = { i:int | i <= 0 } 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) // typedef 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 - v1) viewdef vtakeout0 (v:view) = vtakeout(void, v) // vtypedef vttakeout ( vt1:vt@ype , vt2:vt@ype ) = (vt2 - vt1 | vt2) vtypedef vttakeout0 (vt:vt@ype) = vttakeout(void, vt) // (* ****** ****** *) // vtypedef vtakeoutptr (a:vt@ype) = [l:addr] (a@l, a@l - 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) - int typedef cmpval_funenv (a: t@ype, vt: t@ype) = (a, a, !vt) - int // stadef cmpval = cmpval_fun and cmpval = cmpval_funenv // (* ****** ****** *) // typedef cmpref_fun (a: vt@ype) = (&RD(a), &RD(a)) - int typedef cmpref_funenv (a: vt@ype, vt: vt@ype) = (&RD(a), &RD(a), !vt) - 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) - bool typedef compare_type(a: t@ype) = (a, a) - 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} (): void prfun prop_verify_and_add{b:bool | b} (): [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): 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)): void = "mac#%" // overload free with cloptr_free of 0 // (* ****** ****** *) // fun {a:t0p} lazy_force(lazyval: lazy(INV(a))): (a) // fun {a:vt0p} lazy_vt_force(lazyval: lazy_vt(INV(a))): (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)): void = "mac#%" // overload ~ with lazy_vt_free of 0 overload free with lazy_vt_free of 0 // (* ****** ****** *) // // HX-2014: // macro implemented in [pats_ccomp_instrset] // fun lazy2cloref {a:t0p} (lazy(a)): ((*void*)) - (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: INV(a)):<> stamped_t(a) // end of [stamp_t] castfn stamp_vt {a:vt@ype}(x: INV(a)):<> stamped_vt(a) // end of [stamp_vt] // (* ****** ****** *) // 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)): void praxi opt_unsome{a:vt0p} (x: !opt(INV(a), true) >> a): void // fun{a:vt0p} opt_unsome_get(x: &opt(INV(a), true) >> a?): (a) // praxi opt_none{a:vt0p} (x: !(a?) >> opt(a, false)): void praxi opt_unnone{a:vt0p} (x: !opt(INV(a), false) >> a?): void // praxi opt_clear{a:t0p} {b:bool}(x: !opt(INV(a), b) >> a?): 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): 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): {a:t0p}(a) = "mac#%" fun exit_errmsg (ecode: int, msg: string): {a:t0p}(a) = "mac#%" // (* fun exit_fprintf{ts:types} ( ecode: int, out: FILEref, fmt: printf_c ts, args: ts ) : {a:vt0p}(a) = "mac#%" // end of [exit_fprintf] *) // (* *****p* ****** *) // fun exit_void (ecode: int): void = "mac#%" fun exit_errmsg_void (ecode: int, msg: string): void = "mac#%" // (* ****** ****** *) // fun assert_bool0 (x: bool): void = "mac#%" fun assert_bool1 {b:bool} (x: bool (b)): [b] void = "mac#%" // overload assert with assert_bool0 of 0 overload assert with assert_bool1 of 10 // (* ****** ****** *) // fun{} assertexn_bool0 (x: bool): void fun{} assertexn_bool1 {b:bool} (x: bool (b)): [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): void = "mac#%" fun assert_errmsg_bool1 {b:bool} (x: bool b, msg: string): [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): void = "mac#%" fun assert_errmsg2_bool1{b:bool} (x: bool b, msg1: string, msg2: string): [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)): a // fun {a:vt0p} gcopy_ref (x: &INV(a)): a // (* ****** ****** *) // fun {a:vt0p} gfree_val (x: INV(a)): void // (* fun {a:vt0p} gfree_ref (x: &INV(a) >> a?): void *) // (* ****** ****** *) fun {a:vt0p} ginit_ref (x: &a? >> a): void (* ****** ****** *) fun {a:vt0p} gclear_ref (x: &a >> a?): 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): Strptr1 fun{a:vt0p} tostrptr_ref (x: &INV(a)): 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) // (* ****** ****** *) // fun {a:t0p} print_stamped_t(stamped_t(a)): void fun {a:t0p} prerr_stamped_t(stamped_t(a)): void fun {a:t0p} fprint_stamped_t(out: FILEref, x: stamped_t(a)): void (* // // HX-2017-12-09: // This one does not seem to be so useful // fun {a:vt0p} fprint_stamped_vt(out: FILEref, x: &stamped_vt(a)): void *) // overload print with print_stamped_t overload prerr with prerr_stamped_t overload fprint with fprint_stamped_t // (* ****** ****** *) #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 ifopt(t, x) = if(,(t))then(Some(,(x)))else(None()) macdef ifopt_vt(t, x) = if(,(t))then(Some_vt(,(x)))else(None_vt()) // (* ****** ****** *) // 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) = (,(x0) = x) macdef cmpfn(x0) = lam(x) = 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: Tue Dec 6 09:50:54 2016 *) (* ****** ****** *) // // 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)): Strptr1 // fun g0int2string_int(i0: int): 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)) - 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) ) - 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{} 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)) - 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_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) - 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) - 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) - 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) - 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) - 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) - 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) ) - 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) ) - 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) ) - 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) ) - [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) ) - 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) ) - 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) ) - 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)) - bool(i < 0) typedef g1int_isltez_type (tk:tk) = {i:int} (g1int (tk, i)) - 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)) - bool(i > 0) typedef g1int_isgtez_type (tk:tk) = {i:int} (g1int (tk, i)) - 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)) - bool(i > 0) typedef g1int_isneqz_type (tk:tk) = {i:int} (g1int (tk, i)) - 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) ) - bool(i < j) // typedef g1int_lte_type (tk:tk) = {i,j:int} ( g1int(tk, i) , g1int(tk, j) ) - 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) ) - bool(i > j) // typedef g1int_gte_type (tk:tk) = {i,j:int} ( g1int(tk, i) , g1int(tk, j) ) - 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) ) - bool(i == j) typedef g1int_neq_type (tk:tk) = {i,j:int} ( g1int(tk, i) , g1int(tk, j) ) - 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) ) - 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) ) - 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) ) - 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)) - g1int(k2, i) typedef g1int2uint_type (k1:tk, k2:tk) = {i:nat} (g1int(k1, i)) - 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) ) - [u>=0] g1int(k2, u) typedef g1uint2uint_type (k1:tk, k2:tk) = {u:int} (g1uint(k1, u)) - 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)) - g1uint(tk, i+1) typedef g1uint_pred_type (tk:tk) = {i:int | i > 0} (g1uint(tk, i)) - 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) ) - 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) ) - 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) ) - g1uint(tk, i+j) typedef g1uint_sub_type (tk:tk) = {i,j:int | i >= j} ( g1uint(tk, i) , g1uint(tk, j) ) - 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) ) - 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) ) - [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) ) - [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)) - 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)) - bool(i > 0) typedef g1uint_isneqz_type (tk:tk) = {i:int} (g1uint(tk, i)) - 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) ) - bool(i < j) // endfun typedef g1uint_lte_type (tk:tk) = {i,j:int} ( g1uint(tk, i), g1uint(tk, j) ) - 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) ) - bool(i > j) // endfun typedef g1uint_gte_type (tk:tk) = {i,j:int} ( g1uint(tk, i), g1uint(tk, j) ) - 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) ) - bool(i == j) typedef g1uint_neq_type (tk:tk) = {i,j:int} ( g1uint(tk, i) , g1uint(tk, j) ) - 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) ) - 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) ) - g1uint(tk, max(i, j)) typedef g1uint_min_type (tk:tk) = {i,j:int} ( g1uint(tk, i) , g1uint(tk, j) ) - 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)): List0_vt(intBtw(0, b)) // fun{tk:tk} listize_g0uint_rep {b:int | b >= 2} (g0uint(tk), int(b)): 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: Sun Nov 20 21:18:14 2016 *) (* ****** ****** *) (* Author: Hongwei Xi *) (* Authoremail: hwxi AT cs DOT bu DOT edu *) (* Start time: March, 2012 *) (* ****** ****** *) 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(p) = p + sizeof // ptr_pred(p) = p - sizeof // (* ****** ****** *) // symintr ptr_add ptr_sub // // ptr_add (p, ofs) = p + ofs*sizeof // ptr_sub (p, ofs) = p - ofs*sizeof // (* ****** ****** *) 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}{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)): void // end of [ptr_set] fun{a:vt0p} ptr_exch{l:addr} (pf: !INV(a) @ l | p: ptr l, x: &a >> a): 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): void fun ptr_nullize_tsz {a:vt0p} ( pf: is_nullable (a) | x: &a? >> a, tsz: sizeof_t (a) ) : void = "mac#%" // end of [ptr_nullize_tsz] // (* ****** ****** *) fun{ a:vt0p } ptr_alloc () :<> [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 (l:addr) = ptr // 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): aPtr1(a) fun {a:vt0p} aptr_getfree_elt{l:agz}(aptr(a, l)): (a) // fun {a:t0p} aptr_get_elt{l:agz}(ap: !aptr(INV(a), l)): (a) fun {a:t0p} aptr_set_elt {l:agz}(ap: !aptr(INV(a), l) >> _, x: a): void fun {a:t0p} aptr_exch_elt {l:agz}(ap: !aptr(INV(a), l) >> _, x: &(a)>>_): void // overload [] with aptr_get_elt overload [] with aptr_set_elt // (* ****** ****** *) // 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: Sun Nov 20 21:18:17 2016 *) (* ****** ****** *) 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 ) : void = "mac#%" fun malloc_gc {n:int} ( bsz: size_t (n) ) : [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 ) : void // end-of-fun fun{ } memory$alloc {n:int} ( bsz: size_t (n) ) : [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: Sun Nov 20 21:18:15 2016 *) (* ****** ****** *) (* 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: Sun Nov 20 21:18:15 2016 *) (* ****** ****** *) (* 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) - bool = "mac#%" fun eq_int0_char0 : (int, char) - bool = "mac#%" overload = with eq_char0_int0 of 0 overload = with eq_int0_char0 of 0 fun neq_char0_int0 : (char, int) - bool = "mac#%" fun neq_int0_char0 : (int, char) - 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) - int = "mac#%" fun compare_int0_char0 : (int, char) - 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): 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 (* ****** ****** *) symintr isalpha fun isalpha_int (c: int):<> bool = "mac#%" overload isalpha with isalpha_int of 0 fun isalpha_char (c: char):<> bool = "mac#%" overload isalpha with isalpha_char of 0 symintr isalnum fun isalnum_int (c: int):<> bool = "mac#%" overload isalnum with isalnum_int of 0 fun isalnum_char (c: char):<> bool = "mac#%" overload isalnum with isalnum_char of 0 symintr isascii fun isascii_int (c: int):<> bool = "mac#%" overload isascii with isascii_int of 0 fun isascii_char (c: char):<> bool = "mac#%" overload isascii with isascii_char of 0 symintr isblank fun isblank_int (c: int):<> bool = "mac#%" overload isblank with isblank_int of 0 fun isblank_char (c: char):<> bool = "mac#%" overload isblank with isblank_char of 0 symintr isspace fun isspace_int (c: int):<> bool = "mac#%" overload isspace with isspace_int of 0 fun isspace_char (c: char):<> bool = "mac#%" overload isspace with isspace_char of 0 symintr iscntrl fun iscntrl_int (c: int):<> bool = "mac#%" overload iscntrl with iscntrl_int of 0 fun iscntrl_char (c: char):<> bool = "mac#%" overload iscntrl with iscntrl_char of 0 symintr isdigit fun isdigit_int (c: int):<> bool = "mac#%" overload isdigit with isdigit_int of 0 fun isdigit_char (c: char):<> bool = "mac#%" overload isdigit with isdigit_char of 0 symintr isxdigit fun isxdigit_int (c: int):<> bool = "mac#%" overload isxdigit with isxdigit_int of 0 fun isxdigit_char (c: char):<> bool = "mac#%" overload isxdigit with isxdigit_char of 0 symintr isgraph fun isgraph_int (c: int):<> bool = "mac#%" overload isgraph with isgraph_int of 0 fun isgraph_char (c: char):<> bool = "mac#%" overload isgraph with isgraph_char of 0 symintr isprint fun isprint_int (c: int):<> bool = "mac#%" overload isprint with isprint_int of 0 fun isprint_char (c: char):<> bool = "mac#%" overload isprint with isprint_char of 0 symintr ispunct fun ispunct_int (c: int):<> bool = "mac#%" overload ispunct with ispunct_int of 0 fun ispunct_char (c: char):<> bool = "mac#%" overload ispunct with ispunct_char of 0 symintr islower fun islower_int (c: int):<> bool = "mac#%" overload islower with islower_int of 0 fun islower_char (c: char):<> bool = "mac#%" overload islower with islower_char of 0 symintr isupper fun isupper_int (c: int):<> bool = "mac#%" overload isupper with isupper_int of 0 fun isupper_char (c: char):<> bool = "mac#%" 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: Sun Nov 20 21:18:16 2016 *) (* ****** ****** *) 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) - 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)) - 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)) - 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)) - 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#%" // overload + with add_int_float of 0 overload + with add_float_int of 0 // fun add_int_double (int, double):<> double = "mac#%" fun add_double_int (double, int):<> double = "mac#%" // 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#%" // overload - with sub_int_float of 0 overload - with sub_float_int of 0 // fun sub_int_double (int, double):<> double = "mac#%" fun sub_double_int (double, int):<> double = "mac#%" // 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#%" // overload * with mul_int_float of 0 overload * with mul_float_int of 0 // fun mul_int_double (int, double):<> double = "mac#%" fun mul_double_int (double, int):<> double = "mac#%" // 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#%" overload / with div_int_float of 0 overload / with div_float_int of 0 // fun div_int_double (int, double):<> double = "mac#%" fun div_double_int (double, int):<> double = "mac#%" overload / with div_int_double of 0 overload / with div_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: Wed Jan 4 13:58:15 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*)): strnptr(0) fun{} string_sing(chr: charNZ): 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)): strnptr(n) fun{} string_make_listlen {n:int} (cs: list(charNZ, n), n: int(n)): strnptr(n) (* ****** ****** *) fun{} string_make_rlist {n:int} (cs: list(charNZ, n)): strnptr(n) // end of [string_make_rlist] fun{} string_make_rlistlen {n:int} (cs: list(charNZ, n), n: int(n)): strnptr(n) // end of [string_make_rlistlen] (* ****** ****** *) // fun{} string_make_list_vt {n:int} (cs: list_vt(charNZ, n)): strnptr(n) // fun{} string_make_listlen_vt {n:int} (cs: list_vt(charNZ, n), n: int(n)): strnptr(n) // (* ****** ****** *) // fun{} string_make_rlist_vt {n:int} (cs: list_vt(charNZ, n)): strnptr(n) // fun{} string_make_rlistlen_vt {n:int} (cs: list_vt(charNZ, n), n: int(n)): strnptr(n) // (* ****** ****** *) // fun{} string_make_stream {n:int}(cs: stream(charNZ)): Strptr1 fun{} string_make_stream_vt {n:int}(cs: stream_vt(charNZ)): 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): 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)): Strptr1 fun{} string1_copy {n:int} (cs: NSH(string(n))): 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): string(n) // (* fun{tk:tk} string_fset_at_gint {n:int}{i:nat | i < n} (NSH(string(n)), i: g1int(tk, i), c: charNZ): string(n) fun{tk:tk} string_fset_at_guint {n:int}{i:nat | i < n} (NSH(string(n)), i: g1uint(tk, i), c: charNZ): 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) ) : Strptr1 // end-of-function fun{} string1_append {n1,n2:int} ( x1: NSH(string(n1)), x2: NSH(string(n2)) ) : 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) ) : Strptr1 // end-of-function fun{} string0_append4 ( x1: NSH(string), x2: NSH(string) , x3: NSH(string), x4: NSH(string) ) : Strptr1 // end-of-function fun{} string0_append5 ( x1: NSH(string), x2: NSH(string) , x3: NSH(string), x4: NSH(string), x5: NSH(string) ) : 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) ) : 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) ) : Strptr1 // end of [stringarr] // fun{} stringlst_concat(List(string)): Strptr1 // (* ****** ****** *) // fun{} string_implode {n:int} (cs: list(charNZ, n)): strnptr(n) // fun{} string_explode {n:int} (x: string(n)): 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)) - 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: Tue Dec 20 20:00:16 2016 *) (* ****** ****** *) (* 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): void = "mac#%" fun strnptr_free (x: Strnptr0): 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): void // fun{tk:tk} strnptr_set_at_gint {n:int}{i:nat | i < n} (str: !strnptr(n), i: g1int(tk, i), c: charNZ): void fun{tk:tk} strnptr_set_at_guint {n:int}{i:nat | i < n} (str: !strnptr(n), i: g1uint(tk, i), c: charNZ): 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): Strptr0 fun{} strptr1_copy (x: !Strptr1): Strptr1 fun{} strnptr_copy {n:int} (x: !strnptr (n)): strnptr (n) // (* ****** ****** *) // fun{} strptr_append (x1: !Strptr0, x2: !Strptr0): Strptr0 fun{} strnptr_append{n1,n2:nat} (x1: !strnptr n1, x2: !strnptr n2): strnptr(n1+n2) // (* ****** ****** *) fun{} strptrlst_free (xs: List_vt(Strptr0)): void (* ****** ****** *) fun{} strptrlst_concat (xs: List_vt(Strptr0)): 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: Sun Nov 20 21:18:16 2016 *) (* ****** ****** *) // // 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: Sun Nov 20 21:18:17 2016 *) (* ****** ****** *) // // 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: Sun Nov 20 21:18:17 2016 *) (* ****** ****** *) (* 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)): void (* ****** ****** *) // praxi castview0 {to:view}{from:view} (pf: from): to praxi castview1 {to:view}{from:view} (pf: !INV(from)): to // (* ****** ****** *) // praxi castview2void {to:view}{from:view}(x: !INV(from) >> to): void praxi castvwtp2void {to:vt0p}{from:vt0p}(x: !INV(from) >> to): void // praxi castview2void_at {to:vt0p}{from:vt0p}{l:addr}(x: !INV(from@l) >> to@l): 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 - void | ptr l) castfn ptr1_vtake {a:vt0p}{l:addr} (p0: ptr(l)):<> (a@l, a@l - 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} (r: ref (a)):<> [l:addr] (a@l, a@l - void | ptr l) // end of [ref_vtake] (* ****** ****** *) praxi vtakeout_void {v:view} (pf: !v): vtakeout0 (v) castfn vttakeout_void {a:vt0p} (x: !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)): void fun{a:vt0p} ptr1_set (p: Ptr1, x: INV(a)): void // fun{a:vt0p} ptr0_exch (p: ptr, x: &INV(a) >> a): void fun{a:vt0p} ptr1_exch (p: Ptr1, x: &INV(a) >> a): void // fun{a:vt0p} ptr0_intch (p1: ptr, p2: ptr): void fun{a:vt0p} ptr1_intch (p1: Ptr1, p2: Ptr1): 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): 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): 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): void // !p += x fun{a:t0p} ptr1_addby (p: Ptr1, x: a): void // !p += x // fun{a:t0p} ptr0_subby (p: ptr, x: a): void // !p -= x fun{a:t0p} ptr1_subby (p: Ptr1, x: a): void // !p -= x // fun{a:t0p} ptr0_mulby (p: ptr, x: a): void // !p *= x fun{a:t0p} ptr1_mulby (p: Ptr1, x: a): void // !p *= x // fun{a:t0p} ptr0_divby (p: ptr, x: a): void // !p /= x fun{a:t0p} ptr1_divby (p: Ptr1, x: a): void // !p /= x // fun{a:t0p} ptr0_modby (p: ptr, x: a): void // !p %= x fun{a:t0p} ptr1_modby (p: Ptr1, x: a): 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 - 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): void fun{a:vt0p} cptr_exch(cp: cPtr1(INV(a)), xr: &a >> a): 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: Sun Nov 20 21:18:17 2016 *) (* ****** ****** *) (* 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: Sun Nov 20 21:18:17 2016 *) (* ****** ****** *) (* 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: Sun Nov 20 21:18:17 2016 *) (* ****** ****** *) (* 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): ref a fun{a:vt0p} ref_make_elt (x: a): 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:t0p} ref_get_elt (r: ref a): a fun{a:t0p} ref_set_elt (r: ref a, x: a): void // (* ****** ****** *) // fun{a:vt0p} ref_exch_elt (r: ref a, x: &a>>a): 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 ) : 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 ) : void // end of [ref_app_funenv] (* ****** ****** *) // // HX-2013-10: unsafe but convenient // fun{} ref_vtakeout {a:vt0p} ( ref: ref (a) ) : [l:addr] (a @ l, (a @ l) - 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: Sun Nov 20 21:18:18 2016 *) (* ****** ****** *) (* 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)) - #[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) // (* ****** ****** *) (* 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: Sun Nov 20 21:18:18 2016 *) (* ****** ****** *) // // 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) - void ) : int // end of [int_foreach_cloref] fun{} intrange_foreach_cloref ( l: int, r: int, fwork: (int) - 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) - void ) : int // end of [int_rforeach_cloref] fun{} intrange_rforeach_cloref ( l: int, r: int, fwork: (int) - 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 *) (* Authoremail: gmhwxiATgmailDOTcom *) (* Start time: February, 2012 *) (* ****** ****** *) (* ** Source: ** $PATSHOME/prelude/SATS/CODEGEN/list.atxt ** Time of generation: Sun Jan 1 14:50:58 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)): 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): list_vt(x, 1) fun{x:t0p} list_make_pair (x1: x, x2: x): list_vt(x, 2) (* ****** ****** *) fun{x:t0p} list_make_elt {n:nat} (n: int n, x: x): list_vt(x, n) // end of [list_make_elt] (* ****** ****** *) fun{ } list_make_intrange {l,r:int | l <= r} (l: int l, r: int r): 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 ) : list_vt(a, n) // endfun (* ****** ****** *) // symintr list // fun{a:vt0p} list_make_arrpsz {n:int} (psz: arrpsz (INV(a), n)): 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: NSH(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: NSH(string), sep2: NSH(string) ) : void // end of [fprint_listlist_sep] (* ****** ****** *) (* // // HX: for testing macdef // macdef fprintlst_mac {T:t@ype}(f, out, xs, sep) = let // val out = ,(out) val xs = ,(xs) val sep = ,(sep) // fun loop ( xs: List(T), i: int ) : void = case+ xs of | list_cons (x, xs) => let val () = if i > 0 then fprint_string (out, sep) val () = ,(f) (out, x) in loop (xs, i+1) end | list_nil () => () // in loop (xs, 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)): (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))): 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)): (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 ) : 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_copy {n:int} (xs: list(INV(x), n)): 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)) ) : 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) ) : list_vt(a, i+j) // endfun (* ****** ****** *) fun{ x:t0p } list_extend{n:int} (xs: list(INV(x), n), x: x): 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)): list_vt(a, m*n) // (* ****** ****** *) fun{x:t0p} list_reverse {n:int} (xs: list(INV(x), n)): 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))): 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)): 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)))): List0_vt(x) (* ****** ****** *) // fun{ x:t0p } list_take {n:int}{i:nat | i <= n} (xs: list(INV(x), n), i: int i): 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): [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): [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): (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) - bool):<> bool fun{x:t0p} list_iexists_cloref {n:int} ( xs: list(INV(x), n), pred: (natLt(n), x) - 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) - bool):<> bool fun{x:t0p} list_iforall_cloref {n:int} ( xs: list(INV(x), n), pred: (natLt(n), x) - 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) - bool):<> bool // (* ****** ****** *) // fun{ x:t0p } list_find{n:int} ( xs: list(INV(x), n), x0: &(x)? >> opt(x, i >= 0) ) : #[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))): 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): 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) - bool, env: !vt ) : listLte_vt(x, n) // end-of-function *) // (* ****** ****** *) fun{ x:t0p } list_labelize{n:int} (xs: list(INV(x), n)): 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) - void): void fun{x:t0p} list_app_clo (xs: List(INV(x)), fwork: (x) - void): void fun{x:t0p} list_app_cloref (xs: List(INV(x)), fwork: (x) - 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) - void, env: !vt ) : 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) - y): list_vt(y, n) fun{ x:t0p}{y:vt0p } list_map_clo{n:int} (xs: list(INV(x), n), f: &(x) - y): list_vt(y, n) fun{ x:t0p}{y:vt0p } list_map_cloref{n:int} (xs: list(INV(x), n), f: (x) - 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) - y, env: !vt ) : 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) - Option_vt(y), env: !vt ) : 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) - y, env: !vt ) : 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) - a): list_vt(a, n) fun{ a:vt0p } list_tabulate_clo{n:nat} (n: int n, f: &(natLt(n)) - a): list_vt(a, n) fun{ a:vt0p } list_tabulate_cloref{n:nat} (n: int n, f: natLt(n) - a): list_vt(a, n) (* ****** ****** *) // fun{ x,y:t0p } list_zip{m,n:int} ( xs: list(INV(x), m) , ys: list(INV(y), n) ) : 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) ) : 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) - void ) : void // end of [list_foreach_fun] // fun {x:t0p} list_foreach_clo {fe:eff} ( xs: List(INV(x)), f: &(x) - void ) : 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) - void ) : void // end of [list_foreach_vclo] // fun {x:t0p} list_foreach_cloptr {fe:eff} ( xs: List(INV(x)), f: !(x) - void ) : 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) - void ) : void // end of [list_foreach_vcloptr] // fun {x:t0p} list_foreach_cloref {fe:eff} ( xs: List(INV(x)), f: (x) - void ) : 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) - void , env: !env ) : 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) - 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) - void, env: !vt ) : 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) - 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) - res, snk: res): res // (* ****** ****** *) // fun{ a:t0p } list_mergesort{n:int} (xs: list(INV(a), n)) : 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) ) : list_vt(a, n) // end-of-function fun{ a:t0p } list_mergesort_cloref {n:int} ( xs: list(INV(a), n), cmp: (a, a) - int ) : list_vt(a, n) // end of [list_mergesort_cloref] (* ****** ****** *) // fun{ a:t0p } list_quicksort{n:int} (xs: list(INV(a), n)) : 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) ) : list_vt(a, n) // end-of-function fun{ a:t0p } list_quicksort_cloref {n:int} ( xs: list(INV(a), n), cmp: (a, a) - int ) : list_vt(a, n) // end of [list_quicksort_cloref] (* ****** ****** *) // fun{a:t0p} streamize_list_elt (xs: List(INV(a))): stream_vt(a) // fun{a:t0p} streamize_list_choose2 (xs: List(INV(a))): stream_vt(@(a, a)) // (* ****** ****** *) // fun {a,b:t0p} streamize_list_zip (List(INV(a)), List(INV(b))): stream_vt(@(a, b)) // fun {a,b:t0p} streamize_list_cross (List(INV(a)), List(INV(b))): stream_vt(@(a, b)) // (* ****** ****** *) // // 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. *) (* ****** ****** *) (* ** Source: ** $PATSHOME/prelude/SATS/CODEGEN/list_vt.atxt ** Time of generation: Sat Dec 31 03:54:06 2016 *) (* ****** ****** *) (* Author: Hongwei Xi *) (* Authoremail: hwxi AT cs DOT bu DOT edu *) (* Start time: February, 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 (* ****** ****** *) #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): list_vt(x, 1) fun{x:vt0p} list_vt_make_pair (x1: x, x2: x): 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)): 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): void // (* ****** ****** *) fun{x:vt0p} list_vt_exch_at{n:int} (xs: !list_vt(INV(x), n), i: natLt n, x: &x >> _): 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 ) : 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): x // end of [list_vt_takeout_at] (* ****** ****** *) fun{x:t0p} list_vt_copy{n:int} (xs: !list_vt(INV(x), n)): list_vt(x, n) // end of [list_vt_copy] (* ****** ****** *) // fun{x:vt0p} list_vt_copylin{n:int} (xs: !list_vt(INV(x), n)): 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)) - x): list_vt(x, n) // (* ****** ****** *) fun{x:t0p} list_vt_free (xs: List_vt(INV(x))): void (* ****** ****** *) // fun{x:vt0p} list_vt_freelin (xs: List_vt(INV(x))): void fun{x:vt0p} list_vt_freelin$clear (x: &x >> x?): void // fun{x:vt0p} list_vt_freelin_fun{fe:eff} (xs: List_vt(INV(x)), f: (&x>>x?) - void): void // (* ****** ****** *) // fun{ x:vt0p } list_vt_uninitize {n:int} ( xs: !list_vt(INV(x), n) >> list_vt(x?, n) ) : void // end of [list_vt_uninitize] // fun{x:vt0p} list_vt_uninitize$clear (x: &(x) >> x?): 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?) - void ) : 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) ) : list_vt(a, n1+n2) // endfun (* ****** ****** *) fun{ x:vt0p } list_vt_extend{n:int} (xs1: list_vt(INV(x), n), x2: x): 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)): (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)): 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)): 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): (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)))): List0_vt(x) // end of [list_vt_concat] (* ****** ****** *) fun{x:vt0p} list_vt_separate{n:int} ( xs: &list_vt(INV(x), n) >> list_vt(x, n1) ) : #[n1:nat|n1 <= n] list_vt(x, n-n1) fun{x:vt0p} list_vt_separate$pred (x: &RD(x)): bool (* ****** ****** *) // fun{x:t0p} list_vt_filter{n:int} (list_vt(INV(x), n)): 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)): 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?): void // (* ****** ****** *) 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) - y): list_vt(y, n) fun{ x:vt0p}{y:vt0p } list_vt_map_clo{n:int} (xs: !list_vt(INV(x), n), f: &(&x) - y): list_vt(y, n) fun{ x:vt0p}{y:vt0p } list_vt_map_cloref{n:int} (xs: !list_vt(INV(x), n), f: (&x) - 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>>_?) - y): list_vt(y, n) fun{ x:vt0p}{y:vt0p } list_vt_mapfree_clo{n:int} (xs: list_vt(INV(x), n), f: &(&x>>_?) - y): list_vt(y, n) fun{ x:vt0p}{y:vt0p } list_vt_mapfree_cloref{n:int} (xs: list_vt(INV(x), n), f: ( &x>>_? ) - 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) - void ) : void // end of [list_vt_foreach_fun] fun{ x:vt0p } list_vt_foreach_cloref {fe:eff} ( xs: !List_vt(INV(x)), f: (&x) - void ) : 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) - void, env: !vt ) : 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)): 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) ) : list_vt(a, n) // end of [list_vt_mergesort_fun] // (* ****** ****** *) // fun{ a:vt0p } list_vt_quicksort {n:int} (xs: list_vt(INV(a), n)): 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) ) : list_vt(a, n) // end of [list_vt_quicksort_fun] // (* ****** ****** *) // fun{a:vt0p} streamize_list_vt_elt(List_vt(INV(a))): stream_vt(a) // (* ****** ****** *) // // 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: Thu Dec 22 00:36:39 2016 *) (* ****** ****** *) (* 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))): (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: Sun Nov 20 22:15:34 2016 *) (* ****** ****** *) (* 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): option_vt (a, true) fun{a:vt0p} option_vt_none ((*void*)): option_vt (a, false) (* ****** ****** *) fun{ a:vt0p } option_vt_make_opt {b:bool} ( b: bool(b) , x: &opt (INV(a), b) >> a? ) : 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)): (a) fun {a:vt0p} option_vt_unnone (opt: option_vt(INV(a), false)): void (* ****** ****** *) // fun{a:t0p} option_vt_free (opt: Option_vt(INV(a))): void fun{a:t0p} option2bool_vt {b:bool}(opt: option_vt(INV(a), b)): 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. *) (* ****** ****** *) (* ** Source: ** $PATSHOME/prelude/SATS/CODEGEN/stream.atxt ** Time of generation: Thu Dec 8 23:28:10 2016 *) (* ****** ****** *) 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))): List0_vt(a) // end of [stream2list] (* ****** ****** *) // fun{a:t0p} stream_length(stream(INV(a))): intGte(0) // (* ****** ****** *) fun{a:t0p} stream_head_exn(xs: stream(INV(a))): (a) fun{a:t0p} stream_tail_exn(xs: stream(INV(a))): stream(a) (* ****** ****** *) fun{a:t0p} stream_nth_exn (xs: stream(INV(a)), n: intGte(0)): (a) // end of [stream_nth_exn] fun{a:t0p} stream_nth_opt (xs: stream(INV(a)), n: intGte(0)): Option_vt(a) // end of [stream_nth_opt] (* ****** ****** *) fun{a:t0p} stream_get_at_exn (xs: stream(INV(a)), n: intGte(0)): (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): list_vt(a, n) // end of [stream_take_exn] (* ****** ****** *) fun{a:t0p} stream_drop_exn (xs: stream(INV(a)), n: intGte(0)): stream(a) // end of [stream_drop_exn] fun{a:t0p} stream_drop_opt (xs: stream(INV(a)), n: intGte(0)): Option_vt(stream(a)) // end of [stream_drop_opt] (* ****** ****** *) // fun{a:t0p} stream_append (xs: stream(INV(a)), ys: stream(a)): stream(a) // fun{a:t0p} stream_concat(xss: stream(stream(INV(a)))): stream(a) // (* ****** ****** *) // fun{a:t0p} stream_filter (xs: stream(INV(a))): stream(a) // fun{a:t0p} stream_filter$pred (x: a):<> bool // fun{a:t0p} stream_filter_fun ( xs: stream(INV(a)), pred: (a) - bool ) : stream(a) // end-of-function fun{a:t0p} stream_filter_cloref ( xs: stream(INV(a)), pred: (a) - bool ) : stream(a) // end-of-function // (* ****** ****** *) // fun{ a:t0p}{b:t0p } stream_map (xs: stream(INV(a))): 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)), f: (a) - b): stream(b) fun{ a:t0p}{b:t0p } stream_map_cloref (xs: stream(INV(a)), f: (a) - b): stream(b) // (* ****** ****** *) // fun{ a:t0p}{b:t0p } stream_imap{n:int} (xs: stream(INV(a))): 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)), f: (intGte(0), a) - b ) : stream(b) // end-of-fun fun{ a:t0p}{b:t0p } stream_imap_cloref ( xs: stream(INV(a)), f: (intGte(0), a) - b ) : stream(b) // end-of-fun // (* ****** ****** *) // fun{ a1,a2:t0p}{b:t0p } stream_map2 ( xs1: stream(INV(a1)) , xs2: stream(INV(a2)) ) : 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)), f: (a1, a2) - b ) : stream(b) // end-of-fun fun{ a1,a2:t0p}{b:t0p } stream_map2_cloref ( xs1: stream(INV(a1)) , xs2: stream(INV(a2)), f: (a1, a2) - b ) : stream(b) // end-of-fun // (* ****** ****** *) // fun{ res:t0p}{x:t0p } stream_scan (stream(INV(x)), ini: res): 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) - res ) : stream(res) // end-of-function // fun{ res:t0p}{x:t0p } stream_scan_cloref ( stream(INV(x)), ini: res, (res, x) - res ) : stream(res) // end-of-function // (* ****** ****** *) // fun {a:t0p} stream_merge (stream(INV(a)), stream(a)) : stream(a) // fun{a:t0p} stream_merge$cmp (x1: a, x2: a):<> int // fun {a:t0p} stream_merge_fun ( xs1: stream(INV(a)), xs2: stream(a), (a, a) - int ) : stream(a) // end of [stream_merge_fun] fun {a:t0p} stream_merge_cloref ( xs1: stream(INV(a)), xs2: stream(a), (a, a) - int ) : stream(a) // end of [stream_merge_cloref] (* ****** ****** *) // fun{a:t0p} stream_mergeq (stream(INV(a)), stream(a)): 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), (a, a) - int ) : stream(a) // end of [stream_mergeq_fun] fun{a:t0p} stream_mergeq_cloref ( xs1: stream(INV(a)), xs2: stream(a), (a, a) - int ) : stream(a) // end of [stream_mergeq_cloref] // (* ****** ****** *) // 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) - a): stream(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) - void): void fun{a:t0p} stream_foreach_cloref (xs: stream(a), fwork: (a) - void): void // (* ****** ****** *) // fun{ res:vt0p}{a:t0p } stream_foldleft_fun (xs: stream(a), ini: res, fopr: (res, a) - res): res fun{ res:vt0p}{a:t0p } stream_foldleft_cloref (xs: stream(a), ini: res, fopr: (res, a) - 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) - bool): intGte(0) fun{a:t0p} stream_skip_until_cloref (xs: &stream(INV(a)) >> _, test: (a) - bool): intGte(0) // (* ****** ****** *) // // overloading for certain symbols // (* ****** ****** *) 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. *) (* ****** ****** *) (* ** Source: ** $PATSHOME/prelude/SATS/CODEGEN/stream_vt.atxt ** Time of generation: Sun Jan 1 19:08:53 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)): void // fun{a:t0p} stream_vt_con_free (xs_con: stream_vt_con(a)): 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))): intGte(0) // (* ****** ****** *) // fun{a:t0p} stream_vt_head_exn (stream_vt(INV(a))): (a) fun{a:t0p} stream_vt_tail_exn (stream_vt(INV(a))): stream_vt(a) // fun{a:vt0p} stream_vt_uncons_exn (xs: &stream_vt(INV(a)) >> _): (a) fun{a:vt0p} stream_vt_uncons_opt (xs: &stream_vt(INV(a)) >> _): Option_vt(a) // (* ****** ****** *) // fun{a:t0p} stream_vt_nth_exn (xs: stream_vt(INV(a)), n: intGte(0)): (a) fun{a:t0p} stream_vt_nth_opt (xs: stream_vt(INV(a)), n: intGte(0)): 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) - bool ) : stream_vt (a) // end of [stream_vt_filter_fun] // fun{a:t0p} stream_vt_filter_cloptr ( xs: stream_vt(INV(a)), pred: (&a) - 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) - 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?): 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?!): b // lin-cleared // fun{ a:vt0p}{b:vt0p } stream_vt_map_fun ( xs: stream_vt(INV(a)), fopr: (&a >> a?!) - b ) : stream_vt(b) // end-of-function fun{ a:vt0p}{b:vt0p } stream_vt_map_cloptr ( xs: stream_vt(INV(a)), fopr: (&a >> a?!) - b ) : stream_vt(b) // end-of-function // (* ****** ****** *) // fun{ a1,a2:t0p}{b:vt0p } stream_vt_map2$fopr (x1: &a1 >> _, x2: &a2 >> _): b fun{ a1,a2:t0p}{b:vt0p } stream_vt_map2 ( xs1: stream_vt(INV(a1)) , xs2: stream_vt(INV(a2)) ) : stream_vt(b) // end of [stream_vt_map2] // fun{ a1,a2:t0p}{b:vt0p } stream_vt_map2_fun ( xs1: stream_vt(INV(a1)) , xs2: stream_vt(INV(a2)) , fopr: (&a1 >> _, &a2 >> _) - b ) : stream_vt(b) // end of [stream_vt_map2_fun] fun{ a1,a2:t0p}{b:vt0p } stream_vt_map2_cloptr ( xs1: stream_vt(INV(a1)) , xs2: stream_vt(INV(a2)) , fopr: (&a1 >> _, &a2 >> _) - b ) : stream_vt(b) // 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?!) - 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?!) - void ) : void // end of [stream_vt_foreach_cloptr] // fun{a:vt0p} stream_vt_rforeach_cloptr ( stream_vt(INV(a)), fwork: (&a >> a?!) - void ) : void // end of [stream_vt_rforeach_cloptr] // fun{a:vt0p} stream_vt_iforeach_cloptr ( stream_vt(INV(a)), fwork: (intGte(0), &a >> a?!) - 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?!) - 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?!) - res ) : res // end of [stream_vt_ifoldleft_cloptr] // (* ****** ****** *) fun {env:t0p}{a:t0p} stream_vt_unfold ( st0: env, fopr: (&env >> _) - a ) : stream_vt(a) // end of [stream_vt_unfold] fun {env:t0p}{a:t0p} stream_vt_unfold_opt ( st0: env, fopr: (&env >> _) - 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: Sat Dec 31 03:54:06 2016 *) (* ****** ****** *) (* 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} () - array_v (a, l, 0) // praxi array_v_unnil : {a:vt0p}{l:addr} array_v (a, l, 0) - void // prfun array_v_unnil_nil : {a1,a2:vt0p}{l:addr} array_v (a1, l, 0) - 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)) - array_v (a, l, n+1) // praxi array_v_uncons : {a:vt0p}{l:addr}{n:int | n > 0} array_v (INV(a), l, n) - (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): void // fun{ a:t0p}{tk:tk } array_set_at_guint {n:int} (A: &(@[INV(a)][n]), i: g1uintLt(tk, n), x: a): 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 >> _ ) : void fun{ a:vt0p}{tk:tk } array_exch_at_guint{n:int} ( A: &(@[INV(a)][n]), i: g1uintLt (tk, n), x: &a >> _ ) : 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) ) : void // end of [array_subreverse] (* ****** ****** *) fun {a:vt0p} array_interchange {n:int} ( A: &(@[INV(a)][n]), i: sizeLt (n), j: sizeLt (n) ) : void // end of [array_interchange] (* ****** ****** *) fun {a:vt0p} array_subcirculate {n:int} ( A: &(@[INV(a)][n]), i: sizeLt (n), j: sizeLt (n) ) : 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)) - 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 ) : [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 ) : 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) ) : void // end of [array_copy] (* ****** ****** *) // fun {a:t0p} array_copy_from_list{n:int} ( A: &(@[a?][n]) >> @[a][n], xs: list (INV(a), n) ) : 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) ) : 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 ) : 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) - void , env: !vt ) : 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) - void , env: !vt ) : 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 >> _) - void ) : 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 >> _) - void ) : 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 >> _) - void ) : 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 >> _) - void ) : 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 >> _) - void ) : 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 >> _) - void ) : 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) ) : 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) ) : 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) ) : 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) ) : 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) ) : 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 ) : 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) ) : 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: Wed Dec 21 14:53:04 2016 *) (* ****** ****** *) (* 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) ) : arrayptr (a, n) = "mac#%" // endfun (* ****** ****** *) symintr arrayptr (* ****** ****** *) fun{ a:t0p } arrayptr_make_elt {n:int} (asz: size_t n, x: a): arrayptr (a, n) // end of [arrayptr_make_elt] (* ****** ****** *) fun{ } arrayptr_make_intrange {l,r:int | l <= r} (l: int l, r: int r): 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)): arrayptr (a, n) // end of [arrayptr_make_list] fun{a:t0p} arrayptr_make_rlist{n:int} (asz: int n, xs: list (INV(a), n)): 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 [arrayref_make_subarray] (* ****** ****** *) fun{a:vt0p} arrayptr_make_list_vt{n:int} (asz: int n, xs: list_vt (INV(a), n)): 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)): arrayptr (a, n) // end of [arrayptr_make_rlist_vt] (* ****** ****** *) fun{a:vt0p} arrayptr_make_uninitized {n:int} (asz: size_t n): 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)): 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): 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): 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 >> _): 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 >> _): 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 ) : 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, f: (&a) - void ) : 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 , f: (!v | &a, !vt) - void , env: !vt ) : 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)) - 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: Sun Jan 1 14:50:58 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) ) : 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) ) : 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 ) : arrayref(a, n) // end of [arrayref_make_elt] // (* ****** ****** *) // fun{} arrayref_make_intrange {l,r:int | l <= r} ( l: int l, r: int r ) : 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) ) : arrayref(a, n) // end of [arrayref_make_list] // fun {a:t0p} arrayref_make_rlist {n:int} ( asz: int n, xs: list(INV(a), n) ) : 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)): (a) // A[0] fun {a:t0p} arrayref_tail {n:pos} (A: arrayref(a, n)): 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) ) : (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) ) : (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 ) : 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 ) : 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 >> _ ) : 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 >> _ ) : 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) ) : void // end-of-function // (* ****** ****** *) fun{a:vt0p} arrayref_subcirculate {n:int} ( A: arrayref(a, n), i: sizeLt(n), j: sizeLt(n) ) : 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)) - (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] (* ****** ****** *) // fun {a:vt0p} arrayref_quicksort {n:int}(A: arrayref(a, n), asz: size_t(n)): void // (* ****** ****** *) (* // // HX: see below // fun {a:t0p} streamize_arrayref_elt {n:int} (A: arrayref(a, n), asz: size_t(n)): 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)): 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)): 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) ) : #[n:nat] arrayref(a, n) // end-of-fun // (* ****** ****** *) fun{a:t0p} arrszref_make_elt (asz: size_t, x: a): arrszref(a) // end of [arrszref_make_elt] (* ****** ****** *) fun{a:t0p} arrszref_make_list (xs: List (INV(a))): arrszref(a) // end of [arrszref_make_list] fun{a:t0p} arrszref_make_rlist (xs: List (INV(a))): 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): a // fun{ a:t0p}{tk:tk } arrszref_get_at_gint (A: arrszref(a), i: g0int(tk)): a // fun{ a:t0p}{tk:tk } arrszref_get_at_guint (A: arrszref(a), i: g0uint(tk)): 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): void // fun{ a:t0p}{tk:tk } arrszref_set_at_gint (A: arrszref(a), i: g0int(tk), x: a): void // fun{ a:t0p}{tk:tk } arrszref_set_at_guint (A: arrszref(a), i: g0uint(tk), x: a): 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 >> _ ) : void // fun{ a:vt0p }{tk:tk} arrszref_exch_at_gint ( A0: arrszref(a), i: g0int(tk), x: &a >> _ ) : void // end-of-function // fun{ a:vt0p }{tk:tk} arrszref_exch_at_guint ( A0: arrszref(a), i: g0uint(tk), x: &a >> _ ) : 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): void // end of [arrszref_interchange] // (* ****** ****** *) // fun {a:vt0p} arrszref_subcirculate (A: arrszref(a), i: size_t, j: size_t): 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)) - 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: Sun Nov 20 21:18:20 2016 *) (* ****** ****** *) (* 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 ) : 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 ) : 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 ) : 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 ) : 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 ) : [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 ) : 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 - 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) - 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) - 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: Sun Nov 20 21:18:20 2016 *) (* ****** ****** *) (* 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): 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 ) : 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 ) : 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 ) : 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 ) : 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)): 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)) - 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: Sun Nov 20 21:18:21 2016 *) (* ****** ****** *) (* 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)): 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): 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) ) : (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) ) : (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 ) : 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 ) : 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 >> _ ) : 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 >> _ ) : 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)) - 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) >> _) - 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 ) : 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) ) : #[m,n:nat] matrixref(a, m, n) // endfun (* ****** ****** *) fun{a:t0p} mtrxszref_make_elt (nrow: size_t, ncol: size_t, init: a): mtrxszref(a) // end of [mtrxszref_make_elt] (* ****** ****** *) // fun{a:t0p} mtrxszref_get_at_int (M: mtrxszref(a), i: int, j: int): (a) fun{a:t0p} mtrxszref_get_at_size (M: mtrxszref(a), i: size_t, j: size_t): (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): void fun{a:t0p} mtrxszref_set_at_size (M: mtrxszref(a), i: size_t, j: size_t, x: a): 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) >> _) - 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)) - 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: Sun Dec 25 17:18:00 2016 *) (* ****** ****** *) (* 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: Sun Nov 20 21:18:21 2016 *) (* ****** ****** *) (* 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): Strptr1 (* ****** ****** *) fun{} tostring_uint(uint):<> string fun{} tostrptr_uint(uint): Strptr1 (* ****** ****** *) fun{} tostring_bool(bool):<> string fun{} tostrptr_bool(bool): Strptr1 (* ****** ****** *) fun{} tostring_char(char):<> string fun{} tostrptr_char(char): Strptr1 (* ****** ****** *) fun{} tostring_double(double):<> string fun{} tostrptr_double(double): 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: Sun Dec 18 22:03:02 2016 *) (* ****** ****** *) (* Author: Hongwei Xi *) (* Authoremail: hwxi AT cs DOT bu DOT edu *) (* Start time: March, 2012 *) (* ****** ****** *) // staload UN = "prelude/SATS/unsafe.sats" // (* ****** ****** *) // 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(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} .. ( 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}(*tmp*) gcopy_val (x) = (x) implement (a:t@ype) gcopy_ref (x) = (x) (* ****** ****** *) // implement (a:t@ype) gfree_val (x) = ((*void*)) // (* implement (a:t@ype) gfree_ref (x) = ((*void*)) *) // (* ****** ****** *) // implement gequal_val_val (x, y) = (x = y) implement gequal_val_val (x, y) = (x = y) implement gequal_val_val (x, y) = (x = y) implement gequal_val_val (x, y) = (x = y) implement gequal_val_val (x, y) = (x = y) // (* ****** ****** *) // implement (a:t@ype) gequal_ref_ref (x, y) = gequal_val_val (x, y) // (* ****** ****** *) // implement {a}(*tmp*) tostring_val(x) = let // val str = $effmask_wrt(tostrptr_val(x)) in strptr2string(str) end // end of [tostring_val] // implement {a}(*tmp*) tostring_ref(x) = let // val str = $effmask_wrt(tostrptr_ref(x)) in strptr2string(str) end // end of [tostring_ref] // (* ****** ****** *) implement (a:t@ype) tostrptr_ref (x) = tostrptr_val (x) (* ****** ****** *) implement {a}(*tmp*) fprint_val (out, x) = let val str = tostrptr_val (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 (out, x) = fprint_val (out, x) (* ****** ****** *) (* // // HX-2014-02-25: commented out // implement{a} print_val (x) = fprint_val (stdout_ref, x) implement{a} prerr_val (x) = fprint_val (stderr_ref, x) implement{a} print_ref (x) = fprint_ref (stdout_ref, x) implement{a} prerr_ref (x) = fprint_ref (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 *) (* Authoremail: gmhwxiATgmailDOTcom *) (* Start time: May, 2012 *) (* ****** ****** *) (* ** Source: ** $PATSHOME/prelude/DATS/CODEGEN/integer.atxt ** Time of generation: Tue Dec 6 09:50:55 2016 *) (* ****** ****** *) // #define ATS_DYNLOADFLAG 0 // no dynloading // (* ****** ****** *) // staload UN = "prelude/SATS/unsafe.sats" // (* ****** ****** *) implement g0int2int = g0int2int_int_int (* ****** ****** *) // implement g0int_neg = g0int_neg_int implement g0int_abs = g0int_abs_int implement g0int_succ = g0int_succ_int implement g0int_pred = g0int_pred_int implement g0int_half = g0int_half_int implement g0int_add = g0int_add_int implement g0int_sub = g0int_sub_int implement g0int_mul = g0int_mul_int implement g0int_div = g0int_div_int implement g0int_mod = g0int_mod_int implement g0int_asl = g0int_asl_int implement g0int_asr = g0int_asr_int implement g0int_isltz = g0int_isltz_int implement g0int_isltez = g0int_isltez_int implement g0int_isgtz = g0int_isgtz_int implement g0int_isgtez = g0int_isgtez_int implement g0int_iseqz = g0int_iseqz_int implement g0int_isneqz = g0int_isneqz_int implement g0int_lt = g0int_lt_int implement g0int_lte = g0int_lte_int implement g0int_gt = g0int_gt_int implement g0int_gte = g0int_gte_int implement g0int_eq = g0int_eq_int implement g0int_neq = g0int_neq_int implement g0int_compare = g0int_compare_int implement g0int_max = g0int_max_int implement g0int_min = g0int_min_int // implement fprint_val (out, x) = fprint_int (out, x) // (* ****** ****** *) // implement {}(*tmp*) mul_int1_size0(i, j) = let val i = g1int2uint_int_size(i) in i * j end implement {}(*tmp*) mul_size0_int1(i, j) = let val j = g1int2uint_int_size(j) in i * j end // (* ****** ****** *) 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 = g1int2int_int_int // (* ****** ****** *) // implement g1int_neg = g1int_neg_int implement g1int_abs = g1int_abs_int implement g1int_succ = g1int_succ_int implement g1int_pred = g1int_pred_int implement g1int_half = g1int_half_int implement g1int_add = g1int_add_int implement g1int_sub = g1int_sub_int implement g1int_mul = g1int_mul_int implement g1int_div = g1int_div_int implement g1int_nmod = g1int_nmod_int implement g1int_isltz = g1int_isltz_int implement g1int_isltez = g1int_isltez_int implement g1int_isgtz = g1int_isgtz_int implement g1int_isgtez = g1int_isgtez_int implement g1int_iseqz = g1int_iseqz_int implement g1int_isneqz = g1int_isneqz_int implement g1int_lt = g1int_lt_int implement g1int_lte = g1int_lte_int implement g1int_gt = g1int_gt_int implement g1int_gte = g1int_gte_int implement g1int_eq = g1int_eq_int implement g1int_neq = g1int_neq_int implement g1int_compare = g1int_compare_int implement g1int_max = g1int_max_int implement g1int_min = g1int_min_int // (* ****** ****** *) implement {tk}(*tmp*) g1int_sgn(x) = compare_g1int_int (x, 0) (* ****** ****** *) // 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 pf = mul_make{i,j}() in (pf | g1int_mul (x, y)) // end // end of [let] // 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 q = g1int_div(x, y) in $UN.cast{g1int(tk,ndiv(i,j))}(q) // 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} .. ( 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 = g0int2uint_int_uint // (* ****** ****** *) // // HX: uint -> int // implement g0uint2int = g0uint2int_uint_int // (* ****** ****** *) // // HX: uint -> uint // implement g0uint2uint = g0uint2uint_uint_uint // (* ****** ****** *) // implement g0uint_succ = g0uint_succ_uint implement g0uint_pred = g0uint_pred_uint implement g0uint_half = g0uint_half_uint implement g0uint_add = g0uint_add_uint implement g0uint_sub = g0uint_sub_uint implement g0uint_mul = g0uint_mul_uint implement g0uint_div = g0uint_div_uint implement g0uint_mod = g0uint_mod_uint implement g0uint_lsl = g0uint_lsl_uint implement g0uint_lsr = g0uint_lsr_uint implement g0uint_lnot = g0uint_lnot_uint implement g0uint_lor = g0uint_lor_uint implement g0uint_lxor = g0uint_lxor_uint implement g0uint_land = g0uint_land_uint implement g0uint_isgtz = g0uint_isgtz_uint implement g0uint_iseqz = g0uint_iseqz_uint implement g0uint_isneqz = g0uint_isneqz_uint implement g0uint_lt = g0uint_lt_uint implement g0uint_lte = g0uint_lte_uint implement g0uint_gt = g0uint_gt_uint implement g0uint_gte = g0uint_gte_uint implement g0uint_eq = g0uint_eq_uint implement g0uint_neq = g0uint_neq_uint implement g0uint_compare = g0uint_compare_uint implement g0uint_max = g0uint_max_uint implement g0uint_min = g0uint_min_uint // implement fprint_val (out, x) = fprint_uint (out, x)// (* ****** ****** *) // // HX: int -> uint // implement g1int2uint = g1int2uint_int_uint // (* ****** ****** *) // // HX: uint -> int // implement g1uint2int = g1uint2int_uint_int // (* ****** ****** *) // // HX: uint -> uint // implement g1uint2uint = g1uint2uint_uint_uint // (* ****** ****** *) // implement g1uint_succ = g1uint_succ_uint implement g1uint_pred = g1uint_pred_uint implement g1uint_half = g1uint_half_uint implement g1uint_add = g1uint_add_uint implement g1uint_sub = g1uint_sub_uint implement g1uint_mul = g1uint_mul_uint implement g1uint_div = g1uint_div_uint implement g1uint_mod = g1uint_mod_uint implement g1uint_isgtz = g1uint_isgtz_uint implement g1uint_iseqz = g1uint_iseqz_uint implement g1uint_isneqz = g1uint_isneqz_uint implement g1uint_lt = g1uint_lt_uint implement g1uint_lte = g1uint_lte_uint implement g1uint_gt = g1uint_gt_uint implement g1uint_gte = g1uint_gte_uint implement g1uint_eq = g1uint_eq_uint implement g1uint_neq = g1uint_neq_uint implement g1uint_compare = g1uint_compare_uint implement g1uint_max = g1uint_max_uint implement g1uint_min = 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 = g0int2string_int // (* ****** ****** *) // implement g0string2int = g0string2int_int implement g0string2uint = g0string2uint_uint // (* ****** ****** *) implement {tk}(*tmp*) g1string2int(rep) = g1ofg0_int(g0string2int(rep)) implement {tk}(*tmp*) g1string2uint(rep) = g1ofg0_uint(g0string2uint(rep)) (* ****** ****** *) implement {tk}(*tmp*) lt_g0int_int (x, y) = g0int_lt (x, g0int2int(y)) implement {tk}(*tmp*) lte_g0int_int (x, y) = g0int_lte (x, g0int2int(y)) // implement {tk}(*tmp*) gt_g0int_int (x, y) = g0int_gt (x, g0int2int(y)) implement {tk}(*tmp*) gte_g0int_int (x, y) = g0int_gte (x, g0int2int(y)) // implement {tk}(*tmp*) eq_g0int_int (x, y) = g0int_eq (x, g0int2int(y)) implement {tk}(*tmp*) neq_g0int_int (x, y) = g0int_neq (x, g0int2int(y)) // implement{tk} compare_g0int_int (x, y) = g0int_compare(x, g0int2int(y)) // (* ****** ****** *) implement {tk}(*tmp*) lt_g1int_int (x, y) = g1int_lt (x, g1int2int(y)) implement {tk}(*tmp*) lte_g1int_int (x, y) = g1int_lte (x, g1int2int(y)) // implement {tk}(*tmp*) gt_g1int_int (x, y) = g1int_gt (x, g1int2int(y)) implement {tk}(*tmp*) gte_g1int_int (x, y) = g1int_gte (x, g1int2int(y)) // implement {tk}(*tmp*) eq_g1int_int (x, y) = g1int_eq (x, g1int2int(y)) implement {tk}(*tmp*) neq_g1int_int (x, y) = g1int_neq (x, g1int2int(y)) // implement {tk}(*tmp*) compare_g1int_int (x, y) = g1int_compare (x, g1int2int(y)) // (* ****** ****** *) implement {tk}(*tmp*) lt_g0uint_int (x, y) = g0uint_lt (x, g0int2uint(y)) implement {tk}(*tmp*) lte_g0uint_int (x, y) = g0uint_lte (x, g0int2uint(y)) // implement {tk}(*tmp*) gt_g0uint_int (x, y) = g0uint_gt (x, g0int2uint(y)) implement {tk}(*tmp*) gte_g0uint_int (x, y) = g0uint_gte (x, g0int2uint(y)) // implement {tk}(*tmp*) eq_g0uint_int (x, y) = g0uint_eq (x, g0int2uint(y)) implement {tk}(*tmp*) neq_g0uint_int (x, y) = g0uint_neq (x, g0int2uint(y)) // (* ****** ****** *) implement {tk}(*tmp*) lt_g1uint_int (x, y) = g1uint_lt (x, g1int2uint(y)) implement {tk}(*tmp*) lte_g1uint_int (x, y) = g1uint_lte (x, g1int2uint(y)) // implement {tk}(*tmp*) gt_g1uint_int (x, y) = g1uint_gt (x, g1int2uint(y)) implement {tk}(*tmp*) gte_g1uint_int (x, y) = g1uint_gte (x, g1int2uint(y)) // implement {tk}(*tmp*) eq_g1uint_int (x, y) = g1uint_eq (x, g1int2uint(y)) implement {tk}(*tmp*) neq_g1uint_int (x, y) = g1uint_neq (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: Sun Nov 20 21:18:22 2016 *) (* ****** ****** *) (* 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) implement {a}(*tmp*) ptr0_pred(p) = sub_ptr_bsz(p, sizeof) (* ****** ****** *) // implement {a}{tk} ptr0_add_gint(p, i) = add_ptr_bsz(p, g0int2uint(i) * sizeof) implement {a}{tk} ptr0_sub_gint(p, i) = sub_ptr_bsz(p, g0int2uint(i) * sizeof) // implement {a}{tk} ptr0_add_guint(p, i) = add_ptr_bsz(p, g0uint2uint(i) * sizeof) implement {a}{tk} ptr0_sub_guint(p, i) = sub_ptr_bsz(p, g0uint2uint(i) * sizeof) // (* ****** ****** *) // implement {a}(*tmp*) ptr1_succ{l}(p) = $UN.cast{ptr(l+sizeof(a))}(add_ptr_bsz(p, sizeof)) implement {a}(*tmp*) ptr1_pred{l}(p) = $UN.cast{ptr(l-sizeof(a))}(sub_ptr_bsz(p, sizeof)) // (* ****** ****** *) // implement {a}{tk} ptr1_add_gint{l}{i}(p, i) = $UN.cast{ptr(l+i*sizeof(a))}(ptr0_add_gint(p, i)) implement {a}{tk} ptr1_sub_gint{l}{i}(p, i) = $UN.cast{ptr(l-i*sizeof(a))}(ptr0_sub_gint(p, i)) // implement {a}{tk} ptr1_add_guint{l}{i}(p, i) = $UN.cast{ptr(l+i*sizeof(a))}(ptr0_add_guint(p, i)) implement {a}{tk} ptr1_sub_guint{l}{i}(p, i) = $UN.cast{ptr(l-i*sizeof(a))}(ptr0_sub_guint(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*) ptr_nullize (pf | x) = ( ptr_nullize_tsz{a}(pf | x, sizeof) ) (* ptr_nullize *) (* ****** ****** *) implement {a}(*tmp*) ptr_alloc() = ptr_alloc_tsz{a}(sizeof) (* ****** ****** *) 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*) cptr_succ{l}(cp) = $UN.cast(add_ptr_bsz(cptr2ptr(cp), sizeof)) implement {a}(*tmp*) cptr_pred{l}(cp) = $UN.cast(sub_ptr_bsz(cptr2ptr(cp), sizeof)) // (* ****** ****** *) // implement {a}(*tmp*) aptr_getfree_elt {l}(ap) = x0 where { // val p0 = aptr2ptr(ap) val x0 = $UN.ptr1_get(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) = $UN.ptr1_get(aptr2ptr(ap)) implement {a}(*tmp*) aptr_set_elt(ap, x0) = $UN.ptr1_set(aptr2ptr(ap), x0) // implement {a}(*tmp*) aptr_exch_elt(ap, x0) = $UN.ptr1_exch(aptr2ptr(ap), x0) // (* ****** ****** *) // // implement {a}(*tmp*) aptr_vtget0_elt {l}(ap) = x0 where { // val x0 = $UN.ptr1_get(aptr2ptr(ap)) // prval () = $UN.castvwtp2void(ap) // } (* end of [aptr_vtget0_elt] *) // implement {a}(*tmp*) aptr_vtget1_elt {l}(ap) = let // val x0 = $UN.ptr1_get(aptr2ptr(ap)) // vtypedef res_vt = (minus_v(aptr(a,l),a) | a) // in $UN.castvwtp0{res_vt}(x0) end // end of [aptr_vtget1_elt] // (* ****** ****** *) implement fprint_val (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: Sun Nov 20 21:18:25 2016 *) (* ****** ****** *) 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: Sun Nov 20 21:18:24 2016 *) (* ****** ****** *) (* 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 = 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: Sun Nov 20 21:18:24 2016 *) (* ****** ****** *) (* 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 = fprint_char implement fprint_val = fprint_uchar implement fprint_val = 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: Sun Nov 20 21:18:24 2016 *) (* ****** ****** *) (* 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 = g0int2float_int_float implement g0int2float = g0int2float_int_double implement g0int2float = g0int2float_lint_double (* ****** ****** *) implement g0float2int = g0float2int_float_int implement g0float2int = g0float2int_float_lint implement g0float2int = g0float2int_double_int implement g0float2int = g0float2int_double_lint implement g0float2int = g0float2int_double_llint (* ****** ****** *) implement g0float2float = g0float2float_float_float implement g0float2float = g0float2float_float_double implement g0float2float = g0float2float_double_float implement g0float2float = g0float2float_double_double (* ****** ****** *) implement g0string2float = g0string2float_double (* ****** ****** *) implement g0float_neg = g0float_neg_float implement g0float_abs = g0float_abs_float implement g0float_succ = g0float_succ_float implement g0float_pred = g0float_pred_float implement g0float_add = g0float_add_float implement g0float_sub = g0float_sub_float implement g0float_mul = g0float_mul_float implement g0float_div = g0float_div_float implement g0float_mod = g0float_mod_float implement g0float_lt = g0float_lt_float implement g0float_lte = g0float_lte_float implement g0float_gt = g0float_gt_float implement g0float_gte = g0float_gte_float implement g0float_eq = g0float_eq_float implement g0float_neq = g0float_neq_float implement g0float_compare = g0float_compare_float implement g0float_max = g0float_max_float implement g0float_min = g0float_min_float (* ****** ****** *) implement g0float_neg = g0float_neg_double implement g0float_abs = g0float_abs_double implement g0float_succ = g0float_succ_double implement g0float_pred = g0float_pred_double implement g0float_add = g0float_add_double implement g0float_sub = g0float_sub_double implement g0float_mul = g0float_mul_double implement g0float_div = g0float_div_double implement g0float_mod = g0float_mod_double implement g0float_lt = g0float_lt_double implement g0float_lte = g0float_lte_double implement g0float_gt = g0float_gt_double implement g0float_gte = g0float_gte_double implement g0float_eq = g0float_eq_double implement g0float_neq = g0float_neq_double implement g0float_compare = g0float_compare_double implement g0float_max = g0float_max_double implement g0float_min = g0float_min_double (* ****** ****** *) implement g0float_neg = g0float_neg_ldouble implement g0float_abs = g0float_abs_ldouble implement g0float_succ = g0float_succ_ldouble implement g0float_pred = g0float_pred_ldouble implement g0float_add = g0float_add_ldouble implement g0float_sub = g0float_sub_ldouble implement g0float_mul = g0float_mul_ldouble implement g0float_div = g0float_div_ldouble implement g0float_mod = g0float_mod_ldouble implement g0float_lt = g0float_lt_ldouble implement g0float_lte = g0float_lte_ldouble implement g0float_gt = g0float_gt_ldouble implement g0float_gte = g0float_gte_ldouble implement g0float_eq = g0float_eq_ldouble implement g0float_neq = g0float_neq_ldouble implement g0float_compare = g0float_compare_ldouble implement g0float_max = g0float_max_ldouble implement g0float_min = g0float_min_ldouble (* ****** ****** *) // implement fprint_val = fprint_float implement fprint_val = fprint_double implement fprint_val = 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: Sun Jan 1 19:08:53 2017 *) (* ****** ****** *) (* Author: Hongwei Xi *) (* Authoremail: hwxi AT cs DOT bu DOT edu *) (* Start time: April, 2012 *) (* ****** ****** *) // // // HX: // there is no dynloading at #define ATS_DYNLOADFLAG 0 // run-time // (* ****** ****** *) // 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 ) : ptr = "mac#atspre_string_memcpy" // end of [memcpy] // (* ****** ****** *) // implement {}(*tmp*) string_char(str) = $UN.ptr0_get(string2ptr(str)) // (* ****** ****** *) implement {}(*tmp*) string_nil() = let // val (pfat, pfgc | p0) = malloc_gc(i2sz(1)) val ((*void*)) = $UN.ptr0_set (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 (p0, chr) val ((*void*)) = $UN.ptr0_set_at (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(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(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(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(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(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} .. ( p1: ptr, n2: int n2 ) :<> int = let // val c = $UN.ptr0_get(p1) // in // if c != CNUL then ( if n2 > 0 then loop (ptr_succ(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} .. ( p1: ptr, p2: ptr ) :<> int = let // val c1 = $UN.ptr0_get(p1) val c2 = $UN.ptr0_get(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(p1), ptr_succ(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} .. ( cs: list (char, n), n: int n, p: ptr ) : ptr = let in if n > 0 then let val+list_cons (c, cs) = cs val () = $UN.ptr0_set(p, c) in loop (cs, n-1, ptr_succ(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(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} .. ( cs: list(char, n), n: int n, p: ptr ) : ptr = let in // if n > 0 then let val p1 = ptr_pred(p) val+list_cons (c, cs) = cs val () = $UN.ptr0_set(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(p0, n) val () = $effmask_wrt ($UN.ptr0_set(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(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(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(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(pi, CNUL) in $UN.castvwtp0((pf, fpf | p0)) end // end of [stream_nil] | stream_cons(c, cs) => let val () = $UN.ptr0_set(pi, c) in loop(pf, fpf | cs, p0, ptr_succ(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(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(pi, CNUL) in $UN.castvwtp0((pf, fpf | p0)) end // end of [stream_nil] | ~stream_vt_cons(c, cs) => let val () = $UN.ptr0_set(pi, c) in loop(pf, fpf | cs, p0, ptr_succ(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(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(string2ptr(str)) implement {}(*tmp*) string_tail {n}(str) = ( $UN.cast{string(n-1)}(ptr_succ(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} .. ( 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 = 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):<> 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 (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):<> 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 (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):<> 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 (p1, p0) else i2ssz(~1) end // end of [strstr] (* ****** ****** *) implement {}(*tmp*) strspn{n} (str, accept) = let // prval() = lemma_string_param (str) // extern fun __strspn (string, string):<> sizeLte (n) = "mac#atspre_strspn" // in __strspn (str, accept) end // end of [strspn] implement {}(*tmp*) strcspn{n} (str, reject) = let // prval() = lemma_string_param (str) // extern fun __strcspn (string, string):<> sizeLte (n) = "mac#atspre_strcspn" // in __strcspn (str, 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(p1) val nx: size_t = string_length(x) val () = $UN.ptr0_set(p2, nx) in loop(ptr_succ(p1), ptr_succ(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(p1) val nx = $UN.ptr0_get(p2) val _(*ptr*) = memcpy(pres, $UN.cast{ptr}(x), nx) // in loop2(ptr_succ(p1), ptr_succ(p2), pred(i), pres+nx) end // end of [then] else ( $UN.ptr0_set(pres, CNUL) ) // end // end of [loop2] // val p1 = $UN.cast{ptr}(xs) // val A0 = arrayptr_make_uninitized(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} .. ( x0: string(n) , res: &ptr? >> res(n) ) : void = let val p = string2ptr(x0) val c = $UN.ptr1_get(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(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 (p, c) in loop (ptr_succ (p), n, succ (i)) end else $UN.ptr0_set (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(p) in // if c0 = CNUL then true else ( if string_forall$pred(c0) then loop(ptr0_succ(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(p) in // if c0 = CNUL then true else ( if string_iforall$pred(i, c0) then loop(i+1, ptr0_succ(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 (p) val cont = ( if c != CNUL then string_foreach$cont (c, env) else false // end of [if] ) : bool // end of [val] in if cont then let val () = string_foreach$fwork (c, env) in loop(ptr_succ (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 (p1) val c2 = $UN.ptr0_get (p2) val cont = string_rforeach$cont (c2, env) // end of [val] in if cont then let val () = string_rforeach$fwork (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 (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(p) // in // if isneqz(c0) then ( stream_vt_cons(c0, auxmain(ptr0_succ(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 = fprint_string implement fprint_val = 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: Sun Nov 20 21:18:24 2016 *) (* ****** ****** *) (* Author: Hongwei Xi *) (* Authoremail: hwxi AT cs DOT bu DOT edu *) (* Start time: April, 2012 *) (* ****** ****** *) #define ATS_DYNLOADFLAG 0 // no dynloading at run-time (* ****** ****** *) 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(p) = CNUL end // end of [strptr_is_empty] implement {}(*tmp*) strptr_isnot_empty(str) = let val p = strptr2ptr(str) in $UN.ptr1_get(p) != CNUL end // end of [strptr_isnot_empty] (* ****** ****** *) // implement {}(*tmp*) strnptr_get_at_size(str, i) = $UN.ptr0_get(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(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} .. ( xs: &list_vt(Strptr0, n0)>>list_vt(Strptr1, n1) ) : #[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} .. (xs: list_vt (Strptr1, n)): 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 (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 (p) // in // if (c != NUL) then let val (pf, fpf | p) = $UN.ptr0_vtake{charNZ}(p) val cont = strnptr_foreach$cont (!p, env) // end of [val] in if cont then let val () = strnptr_foreach$fwork (!p, env) prval ((*void*)) = fpf (pf) in loop (ptr_succ (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 (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 (p1) val (pf, fpf | p2) = $UN.ptr0_vtake{charNZ}(p2) val cont = strnptr_rforeach$cont (!p2, env) // end of [val] in if cont then let val () = strnptr_rforeach$fwork (!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 (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: Sun Nov 20 21:18:25 2016 *) (* ****** ****** *) (* 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 - void) } // end of [prval] val x = !p prval () = fpf (pf) } // end of [ptr0_get] implement{a} ptr1_get = ptr0_get (* ****** ****** *) 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 - void) } // end of [prval] val () = !p := x prval () = fpf (pf) } // end of [ptr0_set] implement{a} ptr1_set = ptr0_set (* ****** ****** *) 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 (* ****** ****** *) 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 (* ****** ****** *) implement {a}(*tmp*) ptr0_getinc(p0) = let val p = p0 val x = ptr0_get(p) val () = p0 := ptr_succ(p) in (x) end // end of [ptr0_getinc] implement {a}(*tmp*) ptr1_getinc(p0) = let val p = p0 val x = ptr0_get(p) val () = p0 := ptr_succ(p) in (x) end // end of [ptr1_getinc] (* ****** ****** *) implement {a}(*tmp*) ptr0_setinc(p0, x) = let val p = p0 val () = ptr0_set(p, x) val () = p0 := ptr_succ(p) in (*void*) end // end of [ptr0_setinc] implement {a}(*tmp*) ptr1_setinc(p0, x) = let val p = p0 val () = ptr0_set(p, x) val () = p0 := ptr_succ(p) in (*void*) end // end of [ptr1_setinc] (* ****** ****** *) // implement {a}(*tmp*) ptr0_get_at_int (p, i) = ptr0_get (ptr0_add_gint (p, i)) implement {a}(*tmp*) ptr0_set_at_int (p, i, x) = ptr0_set (ptr0_add_gint (p, i), x) // implement {a}(*tmp*) ptr0_get_at_size (p, i) = ptr0_get (ptr0_add_guint (p, i)) implement {a}(*tmp*) ptr0_set_at_size (p, i, x) = ptr0_set (ptr0_add_guint (p, i), x) // (* ****** ****** *) implement{a} cptr_get (p) = ptr1_get (cptr2ptr(p)) implement{a} cptr_set (p, x) = ptr1_set (cptr2ptr(p), x) implement{a} cptr_exch (p, x) = ptr1_exch (cptr2ptr(p), x) (* ****** ****** *) implement{a} ptr0_addby (p, x) = let val x0 = ptr0_get (p) in ptr0_set (p, gadd_val_val (x0, x)) end // end of [ptr0_addby] implement{a} ptr1_addby = ptr0_addby implement{a} ptr0_subby (p, x) = let val x0 = ptr0_get (p) in ptr0_set (p, gsub_val_val (x0, x)) end // end of [ptr0_subby] implement{a} ptr1_subby = ptr0_subby implement{a} ptr0_mulby (p, x) = let val x0 = ptr0_get (p) in ptr0_set (p, gmul_val_val (x0, x)) end // end of [ptr0_mulby] implement{a} ptr1_mulby = ptr0_mulby implement{a} ptr0_divby (p, x) = let val x0 = ptr0_get (p) in ptr0_set (p, gdiv_val_val (x0, x)) end // end of [ptr0_divby] implement{a} ptr1_divby = ptr0_divby implement{a} ptr0_modby (p, x) = let val x0 = ptr0_get (p) in ptr0_set (p, gmod_val_val (x0, x)) end // end of [ptr0_modby] implement{a} ptr1_modby = ptr0_modby (* ****** ****** *) 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: Sun Nov 20 21:18:26 2016 *) (* ****** ****** *) (* 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: Sun Nov 20 21:18:25 2016 *) (* ****** ****** *) (* 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 (out, x.0) val () = fprint_tup$sep<> (out) val () = fprint_val (out, x.1) val () = fprint_tup$end<> (out) in // nothing end // end of [fprint_tupval2] // implement (a0,a1) fprint_val (out, x) = fprint_tupval2 (out, x) // (* ****** ****** *) // implement {a0,a1,a2} fprint_tupval3 (out, x) = let val () = fprint_tup$beg<> (out) val () = fprint_val (out, x.0) val () = fprint_tup$sep<> (out) val () = fprint_val (out, x.1) val () = fprint_tup$sep<> (out) val () = fprint_val (out, x.2) val () = fprint_tup$end<> (out) in // nothing end // end of [fprint_tupval3] // implement (a0,a1,a2) fprint_val (out, x) = fprint_tupval3 (out, x) // (* ****** ****** *) // implement {a0,a1,a2,a3} fprint_tupval4 (out, x) = let val () = fprint_tup$beg<> (out) val () = fprint_val (out, x.0) val () = fprint_tup$sep<> (out) val () = fprint_val (out, x.1) val () = fprint_tup$sep<> (out) val () = fprint_val (out, x.2) val () = fprint_tup$sep<> (out) val () = fprint_val (out, x.3) val () = fprint_tup$end<> (out) in // nothing end // end of [fprint_tupval4] // implement (a0,a1,a2,a3) fprint_val (out, x) = fprint_tupval4 (out, x) // (* ****** ****** *) // implement {a0,a1} fprint_tupref2 (out, x) = let val () = fprint_tup$beg<> (out) val () = fprint_ref (out, x.0) val () = fprint_tup$sep<> (out) val () = fprint_ref (out, x.1) val () = fprint_tup$end<> (out) in // nothing end // end of [fprint_tupref2] // implement (a0,a1) fprint_ref (out, x) = fprint_tupref2 (out, x) // (* ****** ****** *) // implement {a0,a1,a2} fprint_tupref3 (out, x) = let val () = fprint_tup$beg<> (out) val () = fprint_ref (out, x.0) val () = fprint_tup$sep<> (out) val () = fprint_ref (out, x.1) val () = fprint_tup$sep<> (out) val () = fprint_ref (out, x.2) val () = fprint_tup$end<> (out) in // nothing end // end of [fprint_tupref3] implement (a0,a1,a2) fprint_ref (out, x) = fprint_tupref3 (out, x) // (* ****** ****** *) // implement {a0,a1,a2,a3} fprint_tupref4 (out, x) = let val () = fprint_tup$beg<> (out) val () = fprint_ref (out, x.0) val () = fprint_tup$sep<> (out) val () = fprint_ref (out, x.1) val () = fprint_tup$sep<> (out) val () = fprint_ref (out, x.2) val () = fprint_tup$sep<> (out) val () = fprint_ref (out, x.3) val () = fprint_tup$end<> (out) in // nothing end // end of [fprint_tupref4] // implement (a0,a1,a2,a3) fprint_ref (out, x) = fprint_tupref4 (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 (out, x.0) val () = fprint_tupbox$end<> (out) in // nothing end // end of [fprint_tupbox1] // implement(a0) fprint_val (out, x) = fprint_tupbox1 (out, x) // (* ****** ****** *) // implement {a0,a1} fprint_tupbox2 (out, x) = let val () = fprint_tupbox$beg<> (out) val () = fprint_val (out, x.0) val () = fprint_tupbox$sep<> (out) val () = fprint_val (out, x.1) val () = fprint_tupbox$end<> (out) in // nothing end // end of [fprint_tupbox2] // implement(a0,a1) fprint_val (out, x) = fprint_tupbox2 (out, x) // (* ****** ****** *) // implement {a0,a1,a2} fprint_tupbox3 (out, x) = let val () = fprint_tupbox$beg<> (out) val () = fprint_val (out, x.0) val () = fprint_tupbox$sep<> (out) val () = fprint_val (out, x.1) val () = fprint_tupbox$sep<> (out) val () = fprint_val (out, x.2) val () = fprint_tupbox$end<> (out) in // nothing end // end of [fprint_tupbox3] // implement(a0,a1,a2) fprint_val (out, x) = fprint_tupbox3 (out, x) // (* ****** ****** *) // implement {a0,a1,a2,a3} fprint_tupbox4 (out, x) = let val () = fprint_tupbox$beg<> (out) val () = fprint_val (out, x.0) val () = fprint_tupbox$sep<> (out) val () = fprint_val (out, x.1) val () = fprint_tupbox$sep<> (out) val () = fprint_val (out, x.2) val () = fprint_tupbox$sep<> (out) val () = fprint_val (out, x.3) val () = fprint_tupbox$end<> (out) in // nothing end // end of [fprint_tupbox4] // implement(a0,a1,a2,a3) fprint_val (out, x) = fprint_tupbox4 (out, x) // (* ****** ****** *) implement {a0,a1} tupval2_equal(x, y) = ( // if gequal_val_val(x.0, y.0) then gequal_val_val(x.1, y.1) else false // ) (* end of [tupval2_val_val] *) implement (a0,a1) gequal_val_val (x, y) = tupval2_equal (x, y) (* ****** ****** *) implement {a0,a1,a2} tupval3_equal(x, y) = ( // if gequal_val_val(x.0, y.0) then ( if gequal_val_val(x.1, y.1) then gequal_val_val(x.2, y.2) else false // end of [if] ) else false // ) (* end of [tupval3_val_val] *) implement (a0,a1,a2) gequal_val_val (x, y) = tupval3_equal (x, y) (* ****** ****** *) implement {a0,a1,a2,a3} tupval4_equal(x, y) = ( // if gequal_val_val(x.0, y.0) then ( if gequal_val_val(x.1, y.1) then ( if gequal_val_val(x.2, y.2) then gequal_val_val(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 (x, y) = tupval4_equal (x, y) (* ****** ****** *) implement {a0,a1} tupval2_compare (x, y) = let val sgn0 = gcompare_val_val (x.0, y.0) in if sgn0 != 0 then sgn0 else gcompare_val_val (x.1, y.1) // end of [if] end // end of [tupval2_compare] implement (a0,a1) gcompare_val_val (x, y) = tupval2_compare (x, y) (* ****** ****** *) implement {a0,a1,a2} tupval3_compare (x, y) = let // val sgn0 = gcompare_val_val (x.0, y.0) // in // if sgn0 != 0 then sgn0 else let val sgn1 = gcompare_val_val (x.1, y.1) in if sgn1 != 0 then sgn1 else gcompare_val_val (x.2, y.2) // end of [if] end // end of [if] // end // end of [tupval3_compare] implement (a0,a1,a2) gcompare_val_val (x, y) = tupval3_compare (x, y) (* ****** ****** *) implement {a0,a1,a2,a3} tupval4_compare (x, y) = let // val sgn0 = gcompare_val_val (x.0, y.0) // in // if sgn0 != 0 then sgn0 else let val sgn1 = gcompare_val_val (x.1, y.1) in // if sgn1 != 0 then sgn1 else let val sgn2 = gcompare_val_val (x.2, y.2) in if sgn2 != 0 then sgn2 else gcompare_val_val (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 (x, y) = tupval4_compare (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: Sun Nov 20 21:18:25 2016 *) (* ****** ****** *) (* Author: Hongwei Xi *) (* Authoremail: hwxi AT cs DOT bu DOT edu *) (* Start time: May, 2012 *) (* ****** ****** *) implement {a}(*tmp*) ref = ref_make_elt implement {a}(*tmp*) ref_make_elt (x0) = let val (pfat, pfgc | p) = ptr_alloc () prval () = mfree_gc_v_elim (pfgc) val () = !p := x0 // initialization in ref_make_viewptr (pfat | p) end // end of [ref_make_elt] (* ****** ****** *) 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 - 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: Tue Dec 13 22:33:32 2016 *) (* ****** ****** *) (* 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 (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 (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 = fileref_load_int implement fileref_load = fileref_load_lint implement fileref_load = fileref_load_uint implement fileref_load = fileref_load_ulint // implement fileref_load = fileref_load_float implement fileref_load = fileref_load_double // (* ****** ****** *) implement{a} fileref_get_optval (r) = let var x: a? val yn = fileref_load (r, x) in option_vt_make_opt (yn, x) end // end of [fileref_get_optval] (* ****** ****** *) implement{a} fileref_get_exnmsg (r, msg) = let var x: a? val yn = fileref_load (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 (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 (): 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) 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) // 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, list_vt_cons(c, cs)) else list_vt_cons(c, cs) end // end of [then] else list_vt_cons(c, cs) // end // end of [loop2] // val cs = loop1 () // in case+ cs of | list_vt_cons _ => let val str = string_make_rlist ($UN.list_vt2t(cs)) val () = list_vt_free (cs) 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 (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 (x, env) = fileref_foreach$fwork (x, env) // in ignoret(arrayref_foreach_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] *) (* ****** ****** *) (* 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: Sun Nov 20 21:18:26 2016 *) (* ****** ****** *) (* 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 (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 (l, env) in // if cont then ( intrange_foreach$fwork (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 (i, env) = true implement (env)(*tmp*) intrange_foreach$fwork(i, env) = fwork(i) // var env: void = () // in intrange_foreach_env (l, r, env) end // end of [intrange_foreach_cloref] (* ****** ****** *) implement{} intrange_rforeach (l, r) = let var env: void = () in intrange_rforeach_env (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 (r1, env) in // if cont then ( intrange_rforeach$fwork (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 (i, env) = true implement (env)(*tmp*) intrange_rforeach$fwork(i, env) = fwork(i) // var env: void = () // in intrange_rforeach_env (l, r, env) end // end of [intrange_rforeach_cloref] (* ****** ****** *) implement{} intrange2_foreach (l1, r1, l2, r2) = let var env: void = () in intrange2_foreach_env (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 *) (* Authoremail: gmhwxiATgmailDOTcom *) (* Start time: Feburary, 2012 *) (* ****** ****** *) (* ** Source: ** $PATSHOME/prelude/DATS/CODEGEN/list.atxt ** Time of generation: Thu Dec 29 11:37:20 2016 *) (* ****** ****** *) // 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: 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 } .. ( l: int l, r: int r , res: &ptr? >> res(l) ) : 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) in fold@ (res) 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} .. ( pf: !array_v (a, l, n) >> array_v (a?!, l, n) | p0: ptr l , n0: size_t n , res: &ptr? >> res(n) ) : 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(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(stdout_ref, xs) implement {a}(*tmp*) prerr_list(xs) = fprint_list(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 (i, x, env) = let val () = if i > 0 then fprint_list$sep<(*none*)> (out) // end of [val] in fprint_val (out, x) end // end of [list_iforeach$fwork] // val _(*len*) = list_iforeach (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 (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 (out, xs) = let val xs = $UN.cast{List0(a)}(xs) in fprint_list_sep (out, xs, sep2) end // end of [fprint_val] // in fprint_list_sep (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} .. ( 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 (xs) // in loop (xs, i) end // end of [list_nth] implement {a}(*tmp*) list_nth_opt (xs, i) = let // fun loop {n:nat} .. ( 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 (xs, i) implement {a}(*tmp*) list_get_at_opt (xs, i) = list_nth_opt (xs, i) (* ****** ****** *) implement {a}(*tmp*) list_fset_at (xs, i, x_new) = let // val ( xs1, xs2 ) = $effmask_wrt (list_split_at (xs, i)) // val+list_cons(x_old, xs2) = xs2 val xs2 = list_cons{a}(x_new, xs2) // in $effmask_wrt (list_append1_vt (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 (xs, i)) // val+list_cons(x_old, xs2) = xs2 val xs2 = list_cons{a}(x_new, xs2) // in ($effmask_wrt (list_append1_vt (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} .. ( xs: list (a, n) , i: int i, x: a , res: &ptr? >> list (a, n+1) ) : 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 () = 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} .. ( xs: list (a, n) , i: int i, x0: &a? >> a , res: &ptr? >> list (a, n-1) ) : 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 () = 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} .. ( 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_copy (xs) = res where { // prval() = lemma_list_param(xs) // vtypedef res = List0_vt (x) // fun loop {n:nat} .. ( xs: list (x, n) , res: &res? >> list_vt (x, n) ) : 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 () = 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 of [$effmask_wrt] 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} .. ( xs: list (a, m) , ys: list_vt (a, n) , res: &ptr? >> list_vt (a, m+n) ) : void = case+ xs of | 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 () = fold@ (res) in // nothing end // end of [list_cons] | list_nil () => res := ys // 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(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} .. ( i0: int(i) , xs: list(a, n) , res: list_vt(a, j*n) ) : 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(xs, res)) ) (* end of [else] *) // } (* end of [mul_int_list] *) (* ****** ****** *) implement {x}(*tmp*) list_reverse (xs) = ( list_reverse_append2_vt (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 (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} .. ( xs: list_vt (a, m), ys: list (a, n) ) : list (a, m+n) = let in // case+ xs of | @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 () = fold@ (xs) in loop (xs1_, list_of_list_vt{a}(xs)) end // end of [list_vt_cons] | ~list_vt_nil () => ys // 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} .. ( xs: list (a, m), ys: list_vt (a, n) ) : list_vt (a, m+n) = case+ xs of | list_cons (x, xs) => loop (xs, list_vt_cons{a}(x, ys)) | list_nil () => ys // end of [list_nil] // end of [loop] in loop (xs, ys) end // end of [list_reverse_append2_vt] (* ****** ****** *) implement {a}(*tmp*) list_concat (xss) = let // prval() = lemma_list_param(xss) // typedef T = List (a) fun aux {n:nat} .. ( xs0: T , xss: list (T, n) ) : List0_vt (a) = let prval() = lemma_list_param(xs0) in case+ xss of | list_cons (xs, xss) => let val res = aux (xs, xss) val ys0 = list_copy (xs0) in list_vt_append (ys0, res) end // end of [list_cons] | list_nil () => list_copy (xs0) end // end of [aux] // in // case+ xss of | list_cons (xs, xss) => aux (xs, xss) | list_nil () => list_vt_nil () // end // end of [list_concat] (* ****** ****** *) implement {a}(*tmp*) list_take (xs, i) = let // fun loop {n:int} {i:nat | i <= n} .. ( xs: list (a, n), i: int i , res: &ptr? >> list_vt (a, i) ) : 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 () = 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} .. ( xs: list (a, n), i: int i , res: &ptr? >> list_vt (a, j) ) : #[ 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) => let val ((*void*)) = res := list_vt_cons{a}{0}(x, _) val+list_vt_cons (_, res1) = res val ans = loop (xs1, i-1, res1) in fold@ (res); ans end // 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 (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} .. (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} .. ( xs: list (a, n), i: int i ) : [i <= n] list (a, n-i) = if i > 0 then ( case+ xs of | list_cons (_, xs) => loop (xs, i-1) | list_nil () => $raise ListSubscriptExn() ) 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} .. ( xs: list (x, n), i: int i , res: &ptr? >> list_vt (x, i) ) : 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 () = 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) = lam(xs) => // case+ xs of | list_nil() => false | list_cons(x, xs) => if list_exists$pred (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) = pred($UN.cast{x}(x2)) // in list_exists (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 } .. ( 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) = lam(xs) => // case+ xs of | list_nil() => true | list_cons(x, xs) => if list_forall$pred (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) = pred($UN.cast{x}(x2)) // in list_forall (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 } .. ( 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 implement {x}(*tmp*) list_equal ( xs1, xs2 ) = loop(xs1, xs2) where { fun loop : $d2ctype ( list_equal ) = 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 (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(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 } .. ( xs: list(x, n-i) , i: int(i), x0: &x? >> opt(x, i >= 0) ) : #[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) 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) = lam(xs) => // case+ xs of | list_nil() => $raise NotFoundExn() | list_cons(x, xs) => if list_find$pred(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) = lam(xs) => // case+ xs of | list_nil() => None_vt((*void*)) | list_cons(x, xs) => if list_find$pred(x) then Some_vt{x}(x) else loop(xs) // } (* end of [list_find_opt] *) (* ****** ****** *) implement {key}(*tmp*) list_assoc$eqfn = gequal_val_val 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 (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 (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 (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} .. ( xs: list (x, n) , res: &ptr? >> listLte_vt (x, n) ) : void = ( case+ xs of | list_cons (x, xs) => let val test = list_filter$pred (x) in case+ test of | true => let val () = res := list_vt_cons{x}{0}(x, _(*?*)) val+list_vt_cons (_, res1) = res // res1 = res.1 val () = loop (xs, res1) prval () = fold@ (res) in // nothing end // end of [true] | false => loop (xs, res) end // end of [list_cons] | list_nil () => (res := list_vt_nil) ) // 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} .. ( xs: list (x, n), i: int , res: &ptr? >> list_vt (ix, n) ) : void = let in case+ xs of | list_cons (x, xs) => let 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) in fold@ (res) end // end of [list_cons] | list_nil () => (res := list_vt_nil) 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} .. (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, f) = let // prval() = lemma_list_param(xs) // fun loop{n:nat} .. ( xs: list (x, n), f: (x) - void ) : void = ( // case+ xs of | list_nil () => () | list_cons (x, xs) => (f(x); loop (xs, f)) // ) (* end of [loop] *) // in loop (xs, f) end // end of [list_app_fun] implement {x}(*tmp*) list_app_cloref(xs, f) = let // prval() = lemma_list_param(xs) // fun loop{n:nat} .. ( xs: list (x, n), f: (x) - void ) : void = ( // case+ xs of | list_nil () => () | list_cons (x, xs) => (f(x); loop (xs, f)) // ) (* end of [loop] *) // in loop (xs, f) end // end of [list_app_cloref] (* ****** ****** *) implement {x}{y}(*tmp*) list_map{n}(xs) = let // prval() = lemma_list_param(xs) // fun loop {n:nat} .. ( xs: list (x, n) , res: &ptr? >> list_vt (y, n) ) : void = ( case+ xs of | list_cons (x, xs) => let val y = list_map$fopr (x) val () = res := list_vt_cons{y}{0}(y, _(*?*)) val+list_vt_cons (_, res1) = res // res1 = res.1 val () = loop (xs, res1) prval () = fold@ (res) in // nothing end // end of [list_cons] | list_nil () => (res := list_vt_nil) ) // 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 (xs) end // end of [list_map_fun] implement {x}{y}(*tmp*) list_map_clo (xs, fopr) = let // val fopr = $UN.cast{(x) - y}(addr@fopr) // implement {x2}{y2} list_map$fopr(x2) = $UN.castvwtp0{y2}(fopr($UN.cast{x}(x2))) // in list_map (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 (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} .. ( pfv: !v | xs: list (x, n) , f: (!v | x, !vt) - y , env: !vt , res: &ys? >> list_vt (y, n) ) : void = let in // case+ xs of | 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 () = fold@ (res) in (*nothing*) end // end of [list_vt_cons] | list_nil ( ) => (res := list_vt_nil ()) // 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} .. ( xs: list (x, n), i: int(i) , res: &ptr? >> list_vt (y, n) ) : void = ( case+ xs of | list_cons (x, xs) => let val y = list_imap$fopr (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] | list_nil () => (res := list_vt_nil) ) // 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} .. ( xs: list (x, n) , res: &ptr? >> listLte_vt (y, n) ) : void = let in // case+ xs of | list_cons (x, xs) => let val opt = list_mapopt$fopr (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 () = fold@ (res) in // nothing end // end of [Some_vt] | ~None_vt () => loop (xs, res) end // end of [list_cons] | list_nil () => (res := list_vt_nil) // 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, f, env) = let // prval() = lemma_list_param(xs) // vtypedef ys = List0_vt(y) // fun loop {n:nat} .. ( pfv: !v | xs: list (x, n) , f: (!v | x, !vt) - Option_vt (y) , env: !vt , res: &ys? >> listLte_vt (y, n) ) : void = let in case+ xs of | list_cons (x, xs) => let val opt = f (pfv | x, env) 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 (pfv | xs, f, env, res1) prval () = fold@ (res) in (*nothing*) end // end of [Some_vt] | ~None_vt () => loop (pfv | xs, f, env, res) end // end of [list_vt_cons] | list_nil () => (res := list_vt_nil ()) // end of [list_nil] end // end of [loop] // var res: ys // uninitialized val () = loop (pfv | xs, f, 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) 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: int n, i: int i , res: &ptr? >> list_vt (x, n-i) ) : void = if n > i then let val x = list_tabulate$fopr (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 () = 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, f) = let // val f = $UN.cast{int -> a}(f) // implement(a2) list_tabulate$fopr (n) = $UN.castvwtp0{a2}(f(n)) // in list_tabulate (n) end // end of [list_tabulate_fun] implement {a}(*tmp*) list_tabulate_clo (n, f) = let // val f = $UN.cast{int - a}(addr@f) // implement(a2) list_tabulate$fopr (n) = $UN.castvwtp0{a2}(f(n)) // in list_tabulate (n) end // end of [list_tabulate_clo] implement {a}(*tmp*) list_tabulate_cloref (n, f) = let // val f = $UN.cast{int - a}(f) // implement(a2) list_tabulate$fopr (n) = $UN.castvwtp0{a2}(f(n)) // in list_tabulate (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) = @(x, y) // in $effmask_all(list_zipwith (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} .. ( 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) // 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) = @(x, y) // in $effmask_all (list_crosswith (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} .. ( 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_nil () => (res := list_vt_nil) end // end of [loop1] and loop2 {m,n,n2:nat} .. ( 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) // 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) 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(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} .. ( 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) // end of [val] in if test then let val () = list_foreach$fwork (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, f) = let // fun loop (xs: List(x)): void = // case+ xs of | list_nil () => () | list_cons (x, xs) => (f (x); loop (xs)) // in $effmask_all (loop (xs)) end // end of [list_foreach_fun] (* ****** ****** *) // implement {x}(*tmp*) list_foreach_clo (xs, f) = ( $effmask_all (list_foreach_cloref(xs, $UN.cast(addr@f))) ) (* list_foreach_clo *) implement {x}(*tmp*) list_foreach_vclo (pf | xs, f) = ( $effmask_all (list_foreach_cloref(xs, $UN.cast(addr@f))) ) (* list_foreach_vclo *) // (* ****** ****** *) implement {x}(*tmp*) list_foreach_cloptr (xs, f) = ( $effmask_all (list_foreach_cloref(xs, $UN.castvwtp1(f))) ) (* list_foreach_cloptr *) implement {x}(*tmp*) list_foreach_vcloptr (pf | xs, f) = ( $effmask_all (list_foreach_cloref(xs, $UN.castvwtp1(f))) ) (* list_foreach_vcloptr *) (* ****** ****** *) implement {x}(*tmp*) list_foreach_cloref (xs, f) = let // fun loop (xs: List(x)): void = // case+ xs of | list_nil () => () | list_cons (x, xs) => (f (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, f, env) = let // prval() = lemma_list_param(xs) // fun loop{n:nat} .. ( pfv: !v | xs: list (x, n) , f: (!v | x, !vt) - void , env: !vt ) : void = ( case+ xs of | list_nil() => () | list_cons(x, xs) => let val () = f (pfv | x, env) in loop (pfv | xs, f, env) end // end of [list_cons] ) (* end of [loop] *) // in loop (pfv | xs, f, env) end // end of [list_foreach_funenv] (* ****** ****** *) implement {x,y}(*tmp*) list_foreach2(xs, ys) = let var env: void = () in list_foreach2_env (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} .. ( 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_cons (y, ys) => let val test = list_foreach2$cont (x, y, env) // end of [val] in if test then let val () = list_foreach2$fwork (x, y, env) in loop (xs, ys, env) end else () // end of [if] end // end of [list_cons] | list_nil () => () ) (* 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 (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} .. ( 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 (i, x, env) // end of [test] in if test then let val () = list_iforeach$fwork (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 } .. ( 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 } .. ( pfv: !v | i: int i , xs: list (x, n-i) , fwork: (!v | natLt(n), x, !vt) - void , env: !vt ) : 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 (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} .. ( 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 (i, x, y, env) // end of [val] in if test then let val ((*void*)) = list_iforeach2$fwork (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} .. ( 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) // 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(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} .. ( xs: list (x, n), res: res ) : res = case+ xs of | list_nil() => res | list_cons(x, xs) => list_foldright$fopr (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(xs, snk) end // end of [list_foldright_cloref] (* ****** ****** *) implement {a}(*tmp*) list_mergesort$cmp (x1, x2) = gcompare_val_val(x1, x2) // end of [list_mergesort$cmp] implement {a}(*tmp*) list_mergesort (xs) = let // implement list_vt_mergesort$cmp (x1, x2) = list_mergesort$cmp (x1, x2) // in // let val xs = list_copy(xs) in list_vt_mergesort(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 (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) - int // val cmp2 = $UN.cast{cmp2}(cmp) in cmp2 (x1, x2) // end // end of [list_mergesort$cmp] // in list_mergesort (xs) end // end of [list_mergesort_cloref] (* ****** ****** *) implement {a}(*tmp*) list_quicksort$cmp (x1, x2) = gcompare_val_val(x1, x2) // end of [list_quicksort$cmp] implement {a}(*tmp*) list_quicksort (xs) = let // implement list_vt_quicksort$cmp (x1, x2) = list_quicksort$cmp(x1, x2) // in // let val xs = list_copy (xs) in list_vt_quicksort(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 (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) - int // val cmp2 = $UN.cast{cmp2}(cmp) in cmp2(x1, x2) // end // end of [list_quicksort$cmp] // in list_quicksort (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 Dec 30 12:59:09 2016 *) (* ****** ****** *) (* Author: Hongwei Xi *) (* Authoremail: hwxi AT cs DOT bu DOT edu *) (* Start time: Feburary, 2012 *) (* ****** ****** *) // 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)) // (* ****** ****** *) implement {a}(*tmp*) print_list_vt (xs) = fprint_list_vt (stdout_ref, xs) implement {a}(*tmp*) prerr_list_vt (xs) = fprint_list_vt (stderr_ref, xs) (* ****** ****** *) implement {}(*tmp*) fprint_list_vt$sep (out) = fprint_list$sep<> (out) implement {a}(*tmp*) fprint_list_vt (out, xs) = let // implement(env) list_vt_iforeach$fwork (i, x, env) = let val () = if i > 0 then fprint_list_vt$sep<(*none*)> (out) // end of [val] in fprint_ref (out, x) end // end of [list_iforeach$fwork] // val _(*n*) = list_vt_iforeach (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 (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} .. ( 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(addr@x) // in $effmask_all (list_vt_copylin (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} .. ( 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) val () = res := list_vt_cons{x}{0}(x, _) val+list_vt_cons (_, res1) = res val () = loop (xs1, res1) prval () = fold@ (xs) prval () = fold@ (res) in // nothing end // end of [list_vt_cons] | list_vt_nil () => res := list_vt_nil () // end // end of [loop] // var res: ptr val () = $effmask_all(loop (xs, res)) // in res end // end of [list_vt_copylin] (* ****** ****** *) implement {x}(*tmp*) list_vt_copylin_fun (xs, f) = let // implement {x2}(*tmp*) list_vt_copylin$copy (x) = x2 where { // val f2 = $UN.cast{(&RD(x2))->x2}(f) // val x2 = $effmask_all(f2(x)) // } (* end of [copy] *) // in list_vt_copylin (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 } .. ( xs: &list_vt (a, n), i: int i ) :<> Ptr1 = let in if i > 0 then let val+@list_vt_cons (_, xs1) = xs val res = loop{n-1,i-1}(xs1, pred(i)) in fold@ (xs); res end else $UN.cast2Ptr1(addr@(xs)) // end of [if] 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) } // end of [val] // val pi = list_vt_getref_at (xs, i) val+list_cons (x, _) = $UN.ptr1_get (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 = let extern castfn __ref (xs: !list_vt (a, n)):<> list_vt (a, n) // end of [__ref] in __ref (xs) end // end of [val] // val pi = list_vt_getref_at (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 (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 (xs, i) val xs_i = $UN.cptr_get (pi) val xs1_i = list_vt_cons (x, xs_i) val () = $UN.ptr1_set (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 (xs, i) val xs_i = $UN.cptr_get (pi) val+~list_vt_cons (x1, xs1_i) = xs_i val () = $UN.ptr1_set (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 ($UN.list_vt2t(xs)) // (* ****** ****** *) implement {a}(*tmp*) list_vt_free (xs) = let // implement (a2:t0p) list_vt_freelin$clear (x) = let prval () = topize (x) in (*void*) end // end of [list_vt_freelin$clear] // in list_vt_freelin (xs) end // end of [list_vt_free] (* ****** ****** *) implement {a}(*tmp*) list_vt_freelin$clear (x) = gclear_ref (x) implement {a}(*tmp*) list_vt_freelin (xs) = let // prval () = lemma_list_vt_param (xs) // fun loop {n:nat} .. ( xs: list_vt (a, n) ) : void = ( case+ xs of | @list_vt_cons (x, xs1) => let val () = list_vt_freelin$clear (x) val xs1 = xs1 val () = free@{a}{0}(xs) in loop (xs1) end // end of [list_vt_cons] | ~list_vt_nil () => () ) (* end of [loop] *) // in loop (xs) end // end of [list_vt_freelin] (* ****** ****** *) implement {a}(*tmp*) list_vt_freelin_fun (xs, f) = let // implement {a2}(*tmp*) list_vt_freelin$clear (x) = () where { // val f2 = $UN.cast{(&a2 >> _?) -> void}(f) // val ((*void*)) = $effmask_all(f2(x)) // } (* end of [clear] *) // in list_vt_freelin (xs) end // end of [list_vt_freelin_fun] (* ****** ****** *) implement {a}(*tmp*) list_vt_uninitize$clear (x) = gclear_ref (x) implement {a}(*tmp*) list_vt_uninitize {n} (xs) = let // prval () = lemma_list_vt_param (xs) // fun loop {n:nat} .. ( xs: !list_vt (a, n) >> list_vt (a?, n) ) : void = ( case+ xs of | @list_vt_cons (x, xs1) => let val () = list_vt_uninitize$clear (x) val () = loop (xs1) prval () = fold@ {a?} (xs) in // nothing end // end of [list_vt_cons] | @list_vt_nil () => fold@ {a?} (xs) ) (* end of [loop] *) // in loop (xs) end // end of [list_vt_uninitize] (* ****** ****** *) 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} .. ( xs: &list_vt (a, m) >> list_vt (a, m+n), ys: list_vt (a, n) ) : void = let in // case+ xs of | @list_vt_cons (x, xs1) => let val () = loop (xs1, ys); prval () = fold@ (xs) in (*none*) end // end of [list_vt_cons] | ~list_vt_nil () => (xs := ys) // end (* end of [loop] *) // var res = xs val () = loop (res, ys) // in res end // end of [list_vt_append] (* ****** ****** *) implement {a}(*tmp*) list_vt_extend (xs, y) = list_vt_append (xs, cons_vt{a}(y, nil_vt())) // end of [list_vt_extend] (* ****** ****** *) implement {a}(*tmp*) list_vt_unextend (xs) = let // fun loop {n:pos} .. ( xs: &list_vt (a, n) >> list_vt (a, n-1) ) : (a) = let // val+@list_vt_cons (x, xs1) = xs // in // case+ xs1 of | list_vt_cons _ => let val x = loop (xs1) prval () = fold@ (xs) in x end // end of [list_vt_cons] | 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] // end // end of [loop] // in loop (xs) end // end of [list_vt_unextend] (* ****** ****** *) implement {a}(*tmp*) list_vt_reverse (xs) = list_vt_reverse_append (xs, list_vt_nil) (* ****** ****** *) 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} .. ( xs: list_vt (a, m), ys: list_vt (a, n) ) : list_vt (a, m+n) = case+ xs of | @list_vt_cons (_, xs1) => let val xs1_ = xs1 val () = xs1 := ys; prval () = fold@ (xs) in loop (xs1_, xs) end // end of [cons] | ~list_vt_nil () => ys (* 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} .. ( xs: &list_vt (x, n) >> list_vt (x, i), i: int i ) : list_vt (x, n-i) = ( if i > 0 then let // val+@cons_vt (x, xs1) = xs val res = loop (xs1, i-1) prval ((*void*)) = 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} .. ( res: VT, xss: list_vt (VT, n) ) : VT0 = let in case+ xss of | ~list_vt_cons (xs, xss) => let val res = list_vt_append (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_separate (xs) = let // prval () = lemma_list_vt_param (xs) // fun loop {n:nat} .. ( xs: list_vt (a, n) , res1: &ptr? >> list_vt (a, n1) , res2: &ptr? >> list_vt (a, n2) ) : #[n1,n2:nat | n1+n2==n] void = let in // case+ xs of | @list_vt_cons (x, xs_tl) => let val xs_tl_v = xs_tl val test = list_vt_separate$pred (x) in if test then let val () = res1 := xs val () = loop (xs_tl_v, xs_tl, res2) in fold@ (res1) end else let val () = res2 := xs val () = loop (xs_tl_v, res1, xs_tl) in fold@ (res2) end // end of [if] end // end of [list_vt_cons] | ~list_vt_nil () => ( res1 := list_vt_nil; res2 := list_vt_nil ) // end // end of [loop] // var res1: ptr var res2: ptr val () = loop (xs, res1, res2) val () = xs := res1 // in res2 end // end of [list_vt_separate] (* ****** ****** *) implement {a}(*tmp*) list_vt_filter (xs) = let // implement list_vt_filterlin$pred (x) = list_vt_filter$pred (x) implement list_vt_filterlin$clear (x) = let prval () = topize (x) in (*void*) end // end of [list_vt_filterlin$clear] // in list_vt_filterlin (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} .. ( xs: &list_vt (a, n) >> listLte_vt (a, n) ) : void = let in // case+ xs of | @list_vt_cons (x, xs1) => let val test = list_vt_filterlin$pred (x) in if test then let val () = loop (xs1) in fold@ (xs) end else let val xs1 = xs1 val () = list_vt_filterlin$clear (x) val () = free@{a}{0}(xs) val () = 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 // in loop (xs); xs end // end of [list_vt_filterlin] (* ****** ****** *) implement {a}(*tmp*) list_vt_filterlin$clear (x) = gclear_ref (x) (* ****** ****** *) implement {a}(*tmp*) list_vt_app (xs) = let in // case+ xs of | @list_vt_cons (x, xs1) => let val () = list_vt_app$fwork (x) val () = list_vt_app (xs1) prval () = 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 (x) val () = free@ {a}{0} (xs) in list_vt_appfree (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} .. ( 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_map$fopr (x) // end of [val] val () = res := list_vt_cons{b}{0}(y, _) val+list_vt_cons (_, res1) = res val () = loop (xs1, res1) val () = fold@ (xs) prval () = fold@ (res) in // nothing end // end of [list_vt_cons] | list_vt_nil () => (res := list_vt_nil ()) end // end of [loop] // var res: ptr val () = loop (xs, res) // in res end // end of [list_vt_map] (* ****** ****** *) implement {x}{y}(*tmp*) list_vt_map_fun (xs, f) = let // implement {x2}{y2} list_vt_map$fopr (x2) = let val f = $UN.cast{(&x2)->y}(f) in $UN.castvwtp0{y2}(f(x2)) end // end of [list_vt_map$fopr] // in list_vt_map (xs) end // end of [list_vt_map_fun] implement {x}{y}(*tmp*) list_vt_map_clo (xs, f) = let // val f = $UN.cast{(&x) - y}(addr@f) // implement {x2}{y2} list_vt_map$fopr (x2) = let val f = $UN.cast{(&x2)-y}(f) in $UN.castvwtp0{y2}(f(x2)) end // end of [list_vt_map$fopr] // in list_vt_map (xs) end // end of [list_vt_map_clo] implement {x}{y}(*tmp*) list_vt_map_cloref (xs, f) = let // implement {x2}{y2} list_vt_map$fopr (x2) = let val f = $UN.cast{(&x2)-y}(f) in $UN.castvwtp0{y2}(f(x2)) end // end of [list_vt_map$fopr] // in list_vt_map (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} .. ( 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 (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] // var res: ptr val () = loop (xs, res) // in res end // end of [list_vt_mapfree] (* ****** ****** *) implement {x}{y}(*tmp*) list_vt_mapfree_fun (xs, f) = let // implement {x2}{y2} list_vt_mapfree$fopr (x2) = let val f = $UN.cast{(&x2>>_?)->y}(f) in $UN.castvwtp0{y2}(f(x2)) end // end of [list_vt_mapfree$fopr] // in list_vt_mapfree (xs) end // end of [list_vt_mapfree_fun] implement {x}{y}(*tmp*) list_vt_mapfree_clo (xs, f) = let // val f = $UN.cast{(&x>>_?) - y}(addr@f) // implement {x2}{y2} list_vt_mapfree$fopr (x2) = let val f = $UN.cast{(&x2>>_?)-y}(f) in $UN.castvwtp0{y2}(f(x2)) end // end of [list_vt_mapfree$fopr] // in list_vt_mapfree (xs) end // end of [list_vt_mapfree_clo] implement {x}{y}(*tmp*) list_vt_mapfree_cloref (xs, f) = let // implement {x2}{y2} list_vt_mapfree$fopr (x2) = let val f = $UN.cast{(&x2>>_?)-y}(f) in $UN.castvwtp0{y2}(f(x2)) end // end of [list_vt_mapfree$fopr] // in list_vt_mapfree (xs) end // end of [list_vt_mapfree_cloref] (* ****** ****** *) implement {x}(*tmp*) list_vt_foreach (xs) = let var env: void = () in list_vt_foreach_env (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} .. ( 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) // end of [val] in if test then let val () = list_vt_foreach$fwork (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, f) = let // prval () = lemma_list_vt_param(xs) // fun loop {n:nat} .. ( xs: !list_vt (a, n), f: (&a) - void ) : void = case+ xs of | @list_vt_cons (x, xs1) => let val () = f (x) val () = loop (xs1, f) in fold@ (xs) end // end of [cons] | list_vt_nil ((*void*)) => () // end of [loop] in loop (xs, f) end // end of [list_vt_foreach_fun] (* ****** ****** *) implement {a}(*tmp*) list_vt_foreach_cloref {fe} (xs, f) = let // prval () = lemma_list_vt_param(xs) // fun loop {n:nat} .. ( xs: !list_vt (a, n), f: (&a) - void ) : void = case+ xs of | @list_vt_cons (x, xs1) => let val () = f (x) val () = loop (xs1, f) in fold@ (xs) end // end of [cons] | list_vt_nil ((*void*)) => () // end of [loop] in loop (xs, f) end // end of [list_vt_foreach_cloref] (* ****** ****** *) implement {a}(*tmp*) list_vt_foreach_funenv {v}{vt}{fe} (pf | xs, f, env) = let // prval () = lemma_list_vt_param (xs) // fun loop {n:nat} .. ( pf: !v | xs: !list_vt (a, n) , f: (!v | &a, !vt) - void , env: !vt ) : void = case+ xs of | @list_vt_cons (x, xs1) => let val () = f (pf | x, env) val () = loop (pf | xs1, f, env) in fold@ (xs) end // end of [cons] | list_vt_nil ((*void*)) => () // end of [loop] // in loop (pf | xs, f, env) end // end of [list_vt_foreach_funenv] (* ****** ****** *) implement {x}(*tmp*) list_vt_iforeach (xs) = let var env: void = () in list_vt_iforeach_env (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} .. ( 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 (i, x, env) // end of [val] in if test then let val () = list_vt_iforeach$fwork (i, x, env) // end of [val] val i = loop (succ(i), xs1, env) prval () = fold@ (xs) in i // the number of processed elements end else let prval () = 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(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} .. ( p0: ptr, xs: !list_vt(a, n) ) : void = ( case+ xs of | list_vt_nil() => () | list_vt_cons (_, xs_tl) => let val () = $UN.ptr0_set (p0, $UN.castvwtp1{ptr}(xs)) // end of [val] in loop1(ptr_succ(p0), xs_tl) end // end of [loop1] ) // val n0 = i2sz(list_vt_length(xs)) // val A0 = arrayptr_make_uninitized(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(!p0, n0) // prval ((*void*)) = arrayptr_addback{ptr}(pf | A0) // end // end of [local] // fun loop2 {i:nat|i <= n} .. ( 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(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 () = 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(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: Wed Dec 21 23:29:55 2016 *) (* ****** ****** *) (* 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(stdout_ref, opt) implement {a}(*tmp*) prerr_option(opt) = fprint_option(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 (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: Sun Nov 20 22:16:42 2016 *) (* ****** ****** *) (* 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 (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 *) (* Authoremail: gmhwxiATgmailDOTcom *) (* Start time: July, 2012 *) (* ****** ****** *) (* ** Source: ** $PATSHOME/prelude/DATS/CODEGEN/list.atxt ** Time of generation: Thu Dec 8 23:28:49 2016 *) (* ****** ****** *) 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(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) ) : 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(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(xs, n)) with ~StreamSubscriptExn() => None_vt() // end // end of [stream_nth_opt] (* ****** ****** *) implement {a}(*tmp*) stream_get_at_exn(xs, n) = stream_nth_exn(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 ) = 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 ) = 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(x) then stream_cons{a}(x, stream_filter(xs)) else stream_filter_con(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(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) ) : stream (b) = $delay ( case+ !xs of | stream_nil() => stream_nil() | stream_cons(x, xs) => stream_cons{b}(stream_map$fopr(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(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(xs) end // end of [stream_map_cloref] (* ****** ****** *) implement {a}{b} stream_imap (xs) = let // fun aux ( i: intGte(0), xs: stream (a) ) : stream (b) = $delay ( case+ !xs of | stream_nil() => stream_nil() | stream_cons (x, xs) => let val y = stream_imap$fopr(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(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(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(x1, x2) // end of [val] in stream_cons{b}(y, stream_map2(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(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(xs1, xs2) end // end of [stream_map2_cloref] (* ****** ****** *) implement {res}{x} stream_scan (xs, ini) = let // fun auxmain ( xs: stream(x), ini: res ) : stream(res) = $delay ( case+ !xs of | stream_nil () => stream_nil() // end of [stream_nil] | stream_cons (x, xs) => stream_cons{res} (stream_scan$fopr(ini, x), auxmain(xs, ini)) // end of [stream_cons] ) // end of [$delay] // end of [auxmain] // in stream_make_cons(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(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(xs, ini) end // end of [stream_scan_cloref] (* ****** ****** *) local #define :: stream_cons in (* in of [local] *) implement {a}(*tmp*) stream_merge (xs10, xs20) = $delay ( ( case+ !xs10 of | x1 :: xs1 => ( case+ !xs20 of | x2 :: xs2 => let val sgn = stream_merge$cmp(x1, x2) // end of [val] in if sgn <= 0 then stream_cons{a}(x1, stream_merge (xs1, xs20)) else stream_cons{a}(x2, stream_merge (xs10, xs2)) // end of [if] end // end of [::] | stream_nil() => stream_cons{a}(x1, xs1) ) (* end of [::] *) | stream_nil() => !xs20 ) : stream_con (a) ) // end of [stream_merge] end // end of [local] 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 (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 (xs1, xs2) end // end of [stream_merge_cloref] (* ****** ****** *) // implement {a}(*tmp*) stream_merge$cmp (x1, x2) = gcompare_val_val(x1, x2) // (* ****** ****** *) local #define :: stream_cons in (* in of [local] *) implement {a}(*tmp*) stream_mergeq (xs10, xs20) = $delay ( case+ !xs10 of | x1 :: xs1 => ( case+ !xs20 of | x2 :: xs2 => let val sgn = stream_mergeq$cmp(x1, x2) // end of [val] in if sgn < 0 then stream_cons{a}(x1, stream_mergeq (xs1, xs20)) else if sgn > 0 then stream_cons{a}(x2, stream_mergeq (xs10, xs2)) else stream_cons{a}(x1(*=x2*), stream_mergeq (xs1, xs2)) // end of [if] end // end of [::] | stream_nil() => stream_cons{a}(x1, xs1) ) (* end of [::] *) | stream_nil() => !xs20 ) // end of [stream_mergeq] end // end of [local] 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 (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 (xs1, xs2) end // end of [stream_mergeq_cloref] (* ****** ****** *) // implement {a}(*tmp*) stream_mergeq$cmp (x1, x2) = gcompare_val_val(x1, x2) // (* ****** ****** *) 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(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_foreach (xs) = let var env: void = () in stream_foreach_env(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(x, env) // end of [val] in if test then let val () = stream_foreach$fwork(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(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 {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 (x, env) = if n > env then true else false implement stream_foreach$fwork (x, env) = { val () = if env > 0 then fprint_stream$sep<>(out) // end of [if] val () = env := env + 1 val () = fprint_val(out, x) } (* end of [stream_foreach$fwork] *) // in stream_foreach_env(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(p0, xs) } | stream_cons(x1, xs2) => if test(x1) then loop(xs2, n0+1) else (let val () = $UN.ptr0_set(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) = ~test(x) // in stream_skip_while_cloref(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 *) (* Authoremail: gmhwxiATgmailDOTcom *) (* Start time: July, 2012 *) (* ****** ****** *) (* ** Source: ** $PATSHOME/prelude/DATS/CODEGEN/list.atxt ** Time of generation: Tue Dec 6 22:22:04 2016 *) (* ****** ****** *) 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(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(x, stream_vt_make_nil()) // (* ****** ****** *) // implement {a}(*tmp*) stream_vt_make_con(xs_con) = ( // $ldelay ( xs_con , $effmask_wrt(stream_vt_con_free(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) ) : 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 ) : 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) = 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) = 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) = 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_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 ) = 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 ) = 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 ) = 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(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(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(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) - 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) - 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(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(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 (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 (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) = 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 {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 (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 (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 (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 ) = 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(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(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(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(x, env) in if test then let val xs1 = xs1 val ((*void*)) = stream_vt_foreach$fwork(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(x0, env) = true(*cont*) (* ****** ****** *) implement {a}(*tmp*) stream_vt_foreach_cloptr (xs, fwork) = let // fun loop : $d2ctype ( stream_vt_foreach_cloptr ) = 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?!) - 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?!) - 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) = 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?!) - 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($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($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(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(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: Sun Nov 20 21:18:28 2016 *) (* ****** ****** *) (* 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 (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 (addr@(A), i) in $UN.ptr0_get (p) end // end of [array_get_at_gint] implement {a}{tk}(*tmp*) array_get_at_guint (A, i) = let val p = ptr0_add_guint (addr@(A), i) in $UN.ptr0_get (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 (addr@(A), i) in $UN.ptr0_set (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 (addr@(A), i) in $UN.ptr0_set (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 (addr@(A), i) in $UN.ptr0_exch (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 (addr@(A), i) in $UN.ptr0_exch (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 (p1) val () = $UN.ptr0_set (p1, $UN.ptr0_get (p2)) val () = $UN.ptr0_set (p2, x) in loop (ptr0_succ (p1), ptr0_pred (p2)) end // end of [then] else () // end of [else] ) (* end of [loop] *) // val pA = addr@A val pi = ptr_add (pA, i) val pj = ptr_add (pA, j) // in $effmask_all(loop (pi, ptr0_pred (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 (p0, i) val pj = g1ofg0_ptr(ptr0_add_guint (p0, j)) // end of [val] val (pf, fpf | pj) = $UN.ptr_vtake{a}(pj) val () = $UN.ptr0_exch (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 ) : ptr = "mac#atspre_array_memmove" // in // if i < j then { // val p0 = ptr_add (addr@(A), i) val p1 = ptr_add (addr@(A), j) // val A1 = $UN.ptr0_get (p1) val _(*ptr*) = memmove (ptr_succ(p0), p0, (j-i)*sizeof) val ((*void*)) = $UN.ptr0_set (p0, A1) // } else if i > j then { // val p0 = ptr_add (addr@(A), j) val p1 = ptr_add (addr@(A), i) // val A0 = $UN.ptr0_get (p0) val _(*ptr*) = memmove (p0, ptr_succ(p0), (i-j)*sizeof) val ((*void*)) = $UN.ptr0_set (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 (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) 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} array_ptr_tabulate (asz) = let // val ( pf, pfgc | p ) = array_ptr_alloc (asz) // local implement{a} array_initize$init (i, x) = (x := array_tabulate$fopr(i)) in (*in of [local]*) val () = array_initize (!p, asz) end // end of [local] // in @(pf, pfgc | p) end // end of [array_ptr_tabulate] (* ****** ****** *) implement{a} 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} fprint_array_size (out, A, asz) = let // typedef tenv = int // implement array_foreach$fwork (x, env) = let val n = env val () = if n > 0 then fprint_array$sep<> (out) val () = env := n + 1 in fprint_ref (out, x) end // end of [array_foreach$fwork] // var env: tenv = 0 val _(*n*) = array_foreach_env (A, asz, env) // in // nothing end // end of [fprint_array_size] (* ****** ****** *) implement{} fprint_array$sep (out) = fprint (out, ", ") (* ****** ****** *) implement{a} fprint_array_sep (out, A, asz, sep) = let // implement fprint_array$sep<> (out) = fprint (out, sep) // in fprint_array (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 ) (* 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} array_copy_from_list (A, xs) = let // prval() = lemma_list_param(xs) // fun loop {l:addr}{n:nat} .. ( pf: !array_v (a?, l, n) >> array_v (a, l, n) | p0: ptr l, xs: list (a, n) ) : 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 (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} array_copy_from_list_vt (A, xs) = let // prval() = lemma_list_vt_param(xs) // fun loop {l:addr}{n:nat} .. ( pf: !array_v(a?, l, n) >> array_v(a, l, n) | p0: ptr l, xs: list_vt (a, n) ) : 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 (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} array_copy_to_list_vt (A, n) = res where { // prval() = lemma_array_param(A) // fun loop {l:addr}{n:nat} .. ( pf: !array_v (a, l, n) >> array_v (a?!, l, n) | p0: ptr l, nz: size_t n, res: &ptr? >> list_vt (a, n) ) : 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 (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, 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} .. ( 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 (!p0, env) // end of [val] in if cont then let val () = array_foreach$fwork(!p0, env) // end of [val] val res = loop(pf2 | ptr1_succ(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) - 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 (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) - void // fun app .<>. (pf: !v | x: &a, env: !vt): void = env (x) // end of [fun] var env = fwork prval pfu = unit_v () val ((*void*)) = array_foreach_funenv{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, 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, 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} .. ( 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(!p1, !p2, env) // end of [val] in if cont then let val () = array_foreach2$fwork (!p1, !p2, env) val res = loop ( pf12, pf22 | ptr1_succ(p1), ptr1_succ(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, 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} .. ( 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(i0, !p0, env) // end of [val in if cont then let val () = array_iforeach$fwork(i0, !p0, env) val res = loop (pf2 | ptr1_succ(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} array_rforeach (A, asz) = let var env: void = () in array_rforeach_env (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} .. ( 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 (pz) val (pf2 | p1) = viewptr_match(pf2 | p1) val cont = array_rforeach$cont(!p1, env) in if cont then let val () = array_rforeach$fwork(!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 (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} .. ( 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 (i0, !p0) // end of [val] val () = loop(pf2 | ptr1_succ (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} array_initize_elt (A, asz, elt) = let // implement{a2} array_initize$init (i, xi) = xi := $UN.castvwtp0{a2}(elt) // in $effmask_all (array_initize (A, asz)) end // end of [array_initize_elt] (* ****** ****** *) implement{a} 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 (p0, x) // end of [val] val p0 = ptr_succ (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 (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} 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 (pz) val () = $UN.ptr0_set (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 (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} 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 (p0, x) val p0 = ptr_succ (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 (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} 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 (pz) val () = $UN.ptr0_set (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 (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} array_uninitize (A, asz) = let // fun loop {l:addr}{n:nat} .. ( 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 (i0, !p0) val () = loop (pf2 | ptr_succ (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 (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 (!pa, !pb) prval () = fpfa (pfa) prval () = fpfb ($UN.castview0{(b?)@lb}(pfb)) in loop (ptr_succ (pa), pa2, ptr_succ (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 (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 (!pa, !pb, !pc) prval () = fpfa (pfa) prval () = fpfb (pfb) prval () = fpfc ($UN.castview0{(c?)@lc}(pfc)) in loop (ptr_succ (pa), pa2, ptr_succ (pb), ptr_succ (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(x) = array_bsearch$ford (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} .. ( 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 (ptr0_add_guint(p0, i), !p0) // end of [if] val () = loop (pf2 | ptr1_succ(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: Sun Nov 20 21:18:28 2016 *) (* ****** ****** *) (* 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} .. ( 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} .. ( 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} .. ( 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 = array_v_cons{a}(pf1at, fpf(pfat))) end else let prval EQINT () = eqint_make{i,0}((*void*)) in (pf1at, llam pf1at = 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: Sun Nov 20 21:18:28 2016 *) (* ****** ****** *) (* 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 (asz) // val () = array_initize_elt (!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 (asz) // fun loop {n:nat} .. ( p: ptr, asz: size_t n, l: int ) : void = let in // if asz > 0 then let val () = $UN.ptr0_set (p, l) in loop (ptr0_succ (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 (i2sz(asz)) // val () = array_initize_list (!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 (i2sz(asz)) // val () = array_initize_rlist (!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 ($UN.cast2ptr(A), st) val ( pf1, fpf | p1 ) = $UN.ptr_vtake{array(a,ln)}(p1) // val A2 = arrayptr_make_uninitized (ln) val p2 = ptrcast (A2) prval pf2 = arrayptr_takeout (A2) // val () = array_copy (!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 (i2sz(asz)) val () = array_initize_list_vt (!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 (i2sz(asz)) val () = array_initize_rlist_vt (!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 (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 (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 (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 (ptr1_add_gint (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 (ptr1_add_guint (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 (ptr1_add_gint (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 (ptr1_add_guint (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, 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 (!p, asz, env) prval () = arrayptr_addback (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 (!p, asz, f) prval () = arrayptr_addback (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 (pfv | !p, asz, f, env) prval () = arrayptr_addback (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, 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 (!p, asz, env) prval () = arrayptr_addback (pfarr | A) } // end of [arrayptr_iforeach_env] (* ****** ****** *) implement {a}(*tmp*) arrayptr_rforeach (A, asz) = let var env: void = () in arrayptr_rforeach_env (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 (!p, asz, env) prval () = arrayptr_addback (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 (!p, asz) prval () = arrayptr_addback (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 (!p, asz) prval () = arrayptr_addback (pfarr | A) } // end of [arrayptr_uninitize] (* ****** ****** *) implement {a}(*tmp*) arrayptr_freelin (A, asz) = let // val () = arrayptr_uninitize (A, asz) // in arrayptr_free{a?}(A) end // end of [arrayptr_freelin] (* ****** ****** *) implement {a}(*tmp*) arrayptr_tabulate (asz) = arrayptr_encode2(array_ptr_tabulate (asz)) // end of [arrayptr_tabulate] (* ****** ****** *) implement {a}(*tmp*) arrayptr_tabulate_cloref {n} (asz, f) = let // implement(a2) array_tabulate$fopr (i) = $UN.castvwtp0{a2}(f($UN.cast{sizeLt(n)}(i))) // in arrayptr_tabulate (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 (!p, asz) prval () = arrayptr_addback (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: Sun Nov 20 21:18:28 2016 *) (* ****** ****** *) (* 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 (asz, x)) // end of [arrayref_make_elt] (* ****** ****** *) implement {}(*tmp*) arrayref_make_intrange (l, r) = arrayptr_refize{int}(arrayptr_make_intrange (l, r)) // end of [arrayref_make_intrange] (* ****** ****** *) implement {a}(*tmp*) arrayref_make_list (asz, xs) = arrayptr_refize(arrayptr_make_list (asz, xs)) // end of [arrayref_make_list] implement {a}(*tmp*) arrayref_make_rlist (asz, xs) = arrayptr_refize(arrayptr_make_rlist (asz, xs)) // end of [arrayref_make_rlist] (* ****** ****** *) // implement {a}(*tmp*) arrayref_head(A) = $UN.ptr0_get (arrayref2ptr(A)) implement {a}(*tmp*) arrayref_tail{n}(A) = $UN.cast{arrayref(a,n-1)}(ptr_succ(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 (!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 (!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 (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 (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 (n) val ((*void*)) = array_copy (!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 (asz)) // end of [arrayref_tabulate] implement {a}(*tmp*) arrayref_tabulate_cloref (asz, f) = arrayptr_refize (arrayptr_tabulate_cloref (asz, f)) // end of [arrayref_tabulate_cloref] (* ****** ****** *) implement {a}(*tmp*) arrayref_foreach (A, asz) = let var env: void = () in arrayref_foreach_env (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 (!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, 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 (!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, 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 (!p, asz, env)) end // end of [arrayref_rforeach_env] (* ****** ****** *) implement {a}(*tmp*) arrayref_quicksort (A, asz) = let // val (vbox pf | p) = arrayref_get_viewptr (A) // in $effmask_ref (array_quicksort (!p, asz)) end // end of [arrayref_quicksort] (* ****** ****** *) 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 val A = arrpsz_get_ptrsize (psz, asz) val A = arrayptr_refize (A) // in ARRSZREF(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 (n, x) // in arrszref_make_arrayref (A, n) end // end of [arrszref_make_elt] (* ****** ****** *) implement {a}(*tmp*) arrszref_make_list (xs) = let // val n = list_length (xs) val A = arrayref_make_list (n, xs) // prval () = lemma_list_param (xs) // in arrszref_make_arrayref (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 (xs) val A = arrayref_make_rlist (n, xs) // in arrszref_make_arrayref (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 (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 (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 (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 (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{a}(ASZ, asz) // in streamize_arrayref_elt(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(pa, asz) // fun auxmain ( pa: ptr ) : stream_vt(a) = $ldelay ( if (pa < pz) then stream_vt_cons ($UN.ptr0_get(pa), auxmain(ptr_succ(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: Sun Nov 20 21:18:29 2016 *) (* ****** ****** *) (* 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 (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 (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 (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 (row, col) // implement matrix_initize$init (i, j, x) = x := matrix_tabulate$fopr (i, j) // val () = matrix_initize (!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 (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, m, n, env) end // end of [matrix_foreach] // (* implement {a}{env} matrix_foreach_env (A, m, n, env) = let // implement array_foreach$cont (x, env) = true implement array_foreach$fwork (x, env) = matrix_foreach$fwork (x, env) // val p = addr@(A) prval pf = matrix2array_v{a}(view@(A)) // val _(*mn*) = array_foreach_env (!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(!p, env) // prval ((*void*)) = fpf(pf) // in loop2(ptr_succ(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, 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(!p, n, env) prval ((*void*)) = fpf(pf) // in loop(ptr_add(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 (ij, x) = let in matrix_initize$init (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 (!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 (ij, x) = let in matrix_uninitize$clear (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 (!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 (x, y) = matrix_mapto$fwork (x, y) // in (* in of [local] *) // val ((*void*)) = array_mapto (!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 (x, y, z) = matrix_map2to$fwork (x, y, z) // in (* in of [local] *) // val ((*void*)) = array_map2to (!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: Sun Nov 20 21:18:29 2016 *) (* ****** ****** *) (* 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 (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 (ptr_add (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 (ptr_add (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 (ptr_add (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 (ptr_add (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 (ptr_add (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 (ptr_add (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 (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 (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 (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 (!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(!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(!p, m, n) prval () = matrixptr_addback(pfarr | M) // } (* end of [matrixptr_uninitize] *) (* ****** ****** *) implement {a}(*tmp*) matrixptr_freelin (M, m, n) = let // val () = matrixptr_uninitize(M, m, n) // in matrixptr_free{a?}(M) end // end of [matrixptr_freelin] (* ****** ****** *) implement{a} matrixptr_tabulate (nrow, ncol) = ( matrixptr_encode2(matrix_ptr_tabulate (nrow, ncol)) ) (* end of [matrixptr_tabulate] *) (* ****** ****** *) implement{a} matrixptr_tabulate_cloref {m,n} (nrow, ncol, f) = let // implement(a2) matrix_tabulate$fopr (i, j) = $UN.castvwtp0{a2}(f($UN.cast{sizeLt(m)}(i), $UN.cast{sizeLt(n)}(j))) // in matrixptr_tabulate (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: Sun Nov 20 21:18:29 2016 *) (* ****** ****** *) (* 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 (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 (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 (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, m*n)) end // end of [matrixref_copy] (* ****** ****** *) implement{a} matrixref_tabulate (nrow, ncol) = ( matrixptr_refize (matrixptr_tabulate(nrow, ncol)) ) (* end of [matrixref_tabulate] *) implement{a} matrixref_tabulate_cloref (nrow, ncol, f) = matrixptr_refize (matrixptr_tabulate_cloref(nrow, ncol, f)) // end of [matrixref_tabulate_cloref] (* ****** ****** *) implement{a} matrixref_foreach (A, m, n) = let // var env: void = () // in matrixref_foreach_env (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 (!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, 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 (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 (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 (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, 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 (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 (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 ( 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(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(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(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(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: Sun Dec 25 17:18:00 2016 *) (* ****** ****** *) (* 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 (out, x) end // end of [gprint_val] (* ****** ****** *) implement {a}(*tmp*) gprint_ref (x) = let val out = gprint$out<>() in fprint_ref (out, x) end // end of [gprint_ref] (* ****** ****** *) // implement {}(*tmp*) gprint_int (x) = fprint_val (gprint$out<>(), x) implement {}(*tmp*) gprint_bool (x) = fprint_val (gprint$out<>(), x) implement {}(*tmp*) gprint_char (x) = fprint_val (gprint$out<>(), x) implement {}(*tmp*) gprint_float (x) = fprint_val (gprint$out<>(), x) implement {}(*tmp*) gprint_double (x) = fprint_val (gprint$out<>(), x) implement {}(*tmp*) gprint_string (x) = fprint_val (gprint$out<>(), x) // implement gprint_val (x) = gprint_int (x) implement gprint_val (x) = gprint_char (x) implement gprint_val (x) = gprint_float (x) implement gprint_val (x) = gprint_double (x) implement gprint_val (x) = gprint_string (x) // (* ****** ****** *) // implement{} gprint_list$beg () = gprint_string "(" implement{} gprint_list$end () = gprint_string ")" implement{} gprint_list$sep () = gprint_string ", " // (* ****** ****** *) implement {a}(*tmp*) gprint_list (xs) = let // typedef tenv = int // implement list_foreach$fwork (x, env) = let val () = if env > 0 then gprint_list$sep () val () = env := succ (env) in gprint_val (x) end // end of [list_foreach$fwork] // var env: tenv = 0 val () = gprint_list$beg () val () = list_foreach_env (xs, env) val () = gprint_list$end () // in // nothing end // end of [gprint_list] implement (a)(*tmp*) gprint_val (xs) = gprint_list (xs) (* ****** ****** *) // implement{} gprint_listlist$beg1 () = gprint_string "(" implement{} gprint_listlist$end1 () = gprint_string ")" implement{} gprint_listlist$sep1 () = gprint_string ", " // implement{} gprint_listlist$beg2 () = gprint_string "(" implement{} gprint_listlist$end2 () = gprint_string ")" implement{} gprint_listlist$sep2 () = gprint_string ", " // (* ****** ****** *) // implement {a}(*tmp*) gprint_listlist (xss) = let // typedef xs = List (a) // implement gprint_val (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 (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 (xss) end // end of [gprint_listlist] // (* ****** ****** *) // implement{} gprint_array$beg () = gprint_string "(" implement{} gprint_array$end () = gprint_string ")" implement{} gprint_array$sep () = gprint_string ", " // (* ****** ****** *) implement {a}(*tmp*) gprint_array (A, n) = let // typedef tenv = size_t // implement (env)(*tmp*) array_iforeach$fwork (i, x, env) = let val () = if i > 0 then gprint_array$sep () in gprint_ref (x) end // end of [array_iforeach$fwork] // var env: void = () val () = gprint_array$beg () val _(*n*) = array_iforeach (A, n) val () = gprint_array$end () // in // nothing end // end of [gprint_array] (* ****** ****** *) implement {a}(*tmp*) gprint_arrayptr (A, n) = { val p = ptrcast (A) prval pf = arrayptr_takeout (A) val () = gprint_array (!p, n) prval () = arrayptr_addback (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 (!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, 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: Sun Nov 20 21:18:29 2016 *) (* ****** ****** *) (* 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 = tostring_int implement tostrptr_val = tostrptr_int // (* ****** ****** *) // implement tostrptr_val = g0int2string_lint implement tostrptr_val = 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 = tostring_uint implement tostrptr_val = tostrptr_uint // (* ****** ****** *) // implement {}(*tmp*) tostring_bool(b) = bool2string(b) implement {}(*tmp*) tostrptr_bool(b) = string0_copy(bool2string(b)) // implement tostring_val = tostring_bool implement tostrptr_val = tostrptr_bool // (* ****** ****** *) // implement {}(*tmp*) tostring_char(c) = $effmask_wrt ( strptr2string(char2strptr(c)) ) // implement {}(*tmp*) tostrptr_char(c) = char2strptr(c) // implement tostring_val = tostring_char implement tostrptr_val = 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 = tostring_double implement tostrptr_val = 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 (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 (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 (xs0) = $effmask_all (tostrptr_list (xs0)) // (* ****** ****** *) implement {a}(*tmp*) tostrptr_array (A, n) = let // fun loop{n:int} ( 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 (!p) prval ((*returned*)) = fpf (pf) // val res2 = list_vt_cons (xrep, res1) // in loop (i+1, ptr_succ(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 (res) // in // $UN.castvwtp0{Strptr1}(strptrlst_concat(res)) // end // end of [tostrptr_array] (* ****** ****** *) // implement{} tostrptr_array$beg() = "" implement{} tostrptr_array$end() = "" implement{} tostrptr_array$sep() = "" // (* ****** ****** *) implement {a}(*tmp*) tostrptr_arrayref (A, n) = let // val (vbox pf | p) = arrayref_get_viewptr(A) // in // $effmask_ref(tostrptr_array (!p, n)) // end // end of [tostrptr_arrayref] (* ****** ****** *) implement {a}(*tmp*) tostrptr_arrszref (ASZ) = let // var n: size_t val A = arrszref_get_refsize (ASZ, n) // in tostrptr_arrayref (A, n) end // end of [tostrptr_arrszref] (* ****** ****** *) (* end of [tostring.dats] *) (* end of [ATSPRE_all_in_one.raw] *)