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