staload Fil = "ats_filename.sats"
staload IntInf = "ats_intinf.sats"
staload Lab = "ats_label.sats"
staload "ats_staexp2.sats"
staload "ats_dynexp2.sats"
staload "ats_hiexp.sats"
macdef fprint_label = $Lab.fprint_label
implement
fprint_hityp (pf | out, hit) = let
macdef prstr (s) = fprint1_string (pf | out, ,(s))
in
case+ hit.hityp_node of
| HITextype (name, hitss_arg) => begin
prstr "HITextype(";
fprint_string (pf | out, name);
prstr "; ";
fprint_hityplstlst (pf | out, hitss_arg);
prstr ")"
end | HITfun (fc, hits_arg, hit_res) => begin
prstr "HITfun(";
$Syn.fprint_funclo (pf | out, fc);
prstr "; ";
fprint_hityplst (pf | out, hits_arg);
prstr "; ";
fprint_hityp (pf | out, hit_res);
prstr ")"
end | HITrefarg (refval, hit) => begin
prstr "HITrefarg(";
fprint1_int (pf | out, refval);
prstr "; ";
fprint_hityp (pf | out, hit);
prstr ")"
end | HITtyrecsin hit => begin
prstr "HITtyrecsin(";
fprint_hityp (pf | out, hit);
prstr ")"
end | HITtyrectemp (knd, lhits) => begin
fprint1_string (pf | out, "HITtyrectemp(...)")
end
| HITtysumtemp (d2c, hits) => begin
prstr "HITsumtemp(";
fprint_d2con (pf | out, d2c);
prstr "; ";
fprint_hityplst (pf | out, hits);
prstr ")"
end | HITs2var s2v => begin
prstr "HITs2var("; fprint_s2var (pf | out, s2v); prstr ")"
end | _ => let
val HITNAM (knd, name) = hit.hityp_name
in
if knd > 0 then fprint1_string (pf | out, "*");
fprint1_string (pf | out, name)
end end
implement
fprint_hityplst {m}
(pf | out, hits0) = let
fun aux (
out: &FILE m, i: int, hits: hityplst
) : void =
case+ hits of
| list_cons (hit, hits) => begin
if i > 0 then fprint1_string (pf | out, ", ");
fprint_hityp (pf | out, hit); aux (out, i+1, hits)
end | list_nil () => () in
aux (out, 0, hits0)
end
implement
fprint_hityplstlst {m}
(pf | out, hitss0) = let
fun aux (
out: &FILE m, i: int, hitss: hityplstlst
) : void =
case+ hitss of
| list_cons (hits, hitss) => begin
if i > 0 then fprint1_string (pf | out, ", ");
fprint_hityplst (pf | out, hits); aux (out, i+1, hitss)
end | list_nil () => () in
aux (out, 0, hitss0)
end
implement
print_hityp (hit) = print_mac (fprint_hityp, hit)
implement
prerr_hityp (hit) = prerr_mac (fprint_hityp, hit)
implement
print_hityplst (hits) = print_mac (fprint_hityplst, hits)
implement
prerr_hityplst (hits) = prerr_mac (fprint_hityplst, hits)
implement
fprint_hipat (pf | out, hip0) = let
macdef prstr (s) = fprint1_string (pf | out, ,(s))
in
case+ hip0.hipat_node of
| HIPann (hip, hit_ann) => begin
prstr "HIPann(";
fprint_hipat (pf | out, hip);
prstr "; ";
fprint_hityp (pf | out, hit_ann);
prstr ")"
end | HIPany () => begin
fprint1_string (pf | out, "HIPany()")
end | HIPas (knd, d2v, hip) => begin
prstr "HIPas(";
fprint1_int (pf | out, knd);
prstr "; ";
fprint_d2var (pf | out, d2v);
prstr "; ";
fprint_hipat (pf | out, hip);
prstr ")"
end | HIPbool b => begin
prstr "HIPbool("; fprint1_bool (pf | out, b); prstr ")"
end | HIPchar c => begin
prstr "HIPchar("; fprint1_char (pf | out, c); prstr ")"
end | HIPcon (freeknd, d2c, hips_arg, hit_sum) => begin
prstr "HIPcon(";
fprint1_int (pf | out, freeknd);
prstr "; ";
fprint_d2con (pf | out, d2c);
prstr "; ";
fprint_hipatlst (pf | out, hips_arg);
prstr "; ";
fprint_hityp (pf | out, hit_sum);
prstr ")"
end | HIPcon_any (freeknd, d2c) => begin
prstr "HIPcon_any(";
fprint1_int (pf | out, freeknd);
prstr "; ";
fprint_d2con (pf | out, d2c);
prstr ")"
end | HIPempty () => begin
fprint1_string (pf | out, "HIPempty()");
end | HIPfloat f => begin
fprintf1_exn (pf | out, "HIPfloat(%s)", @(f))
end | HIPint (str, int) => begin
prstr "HIPint(";
$IntInf.fprint_intinf (pf | out, int);
prstr ")"
end | HIPlst (hit_elt, hips_elt) => begin
prstr "HIPlst(";
fprint_hityp (pf | out, hit_elt);
prstr "; ";
fprint_hipatlst (pf | out, hips_elt);
prstr ")"
end | HIPrec (knd, lhips, hit_rec) => begin
prstr "HIPrec(";
fprint1_int (pf | out, knd);
prstr "; ";
fprint_labhipatlst (pf | out, lhips);
prstr "; ";
fprint_hityp (pf | out, hit_rec);
prstr ")"
end | HIPstring s => begin
prstr "HIPstring("; fprint1_string (pf | out, s); prstr ")"
end | HIPvar (refknd, d2v) => begin
prstr "HIPvar("; fprint_d2var (pf | out, d2v); prstr ")"
end end
implement
fprint_hipatlst {m}
(pf | out, hips0) = let
fun aux (
out: &FILE m, i: int, hips: hipatlst
) : void =
case+ hips of
| list_cons (hip, hips) => begin
if i > 0 then fprint1_string (pf | out, ", ");
fprint_hipat (pf | out, hip); aux (out, i+1, hips)
end
| list_nil () => () in
aux (out, 0, hips0)
end
implement
fprint_labhipatlst {m}
(pf | out, lhips0) = let
fun aux
(out: &FILE m, i: int, lhips: labhipatlst): void =
case+ lhips of
| LABHIPATLSTcons (l, hip, lhips) => begin
if i > 0 then fprint1_string (pf | out, ", ");
fprint_label (pf | out, l);
fprint1_string (pf | out, "= ");
fprint_hipat (pf | out, hip);
aux (out, i+1, lhips)
end | LABHIPATLSTdot () => begin
if i > 0 then fprint1_string (pf | out, ", ");
fprint1_string (pf | out, "...")
end | LABHIPATLSTnil () => () in
aux (out, 0, lhips0)
end
implement
print_hipat (hip) = print_mac (fprint_hipat, hip)
implement
prerr_hipat (hip) = prerr_mac (fprint_hipat, hip)
implement
print_hipatlst (hips) = print_mac (fprint_hipatlst, hips)
implement
prerr_hipatlst (hips) = prerr_mac (fprint_hipatlst, hips)
implement
fprint_hiexp (pf | out, hie0) = let
macdef prstr (s) = fprint1_string (pf | out, ,(s))
in
case+ hie0.hiexp_node of
| HIEapp (hit_fun, hie_fun, hies_arg) => begin
prstr "HIEapp(";
fprint_hityp (pf | out, hit_fun);
prstr "; ";
fprint_hiexp (pf | out, hie_fun);
prstr "; ";
fprint_hiexplst (pf | out, hies_arg);
prstr ")"
end | HIEarrinit (hit_elt, ohie_asz, hies_elt) => begin
prstr "HIEarrinit(";
fprint_hityp (pf | out, hit_elt);
prstr "; ";
begin case+ ohie_asz of
| Some hie => fprint_hiexp (pf | out, hie) | None () => ()
end;
prstr "; ";
fprint_hiexplst (pf | out, hies_elt);
prstr ")"
end | HIEarrsize (hit_elt, hies_elt) => begin
prstr "HIEarrsize(";
fprint_hityp (pf | out, hit_elt);
prstr "; ";
fprint_hiexplst (pf | out, hies_elt);
prstr ")"
end | HIEassgn_ptr (hie, hils, hie_val) => begin
prstr "HIEassgn_ptr(";
fprint_hiexp (pf | out, hie);
prstr "; ";
fprint_hilablst (pf | out, hils);
prstr "; ";
fprint_hiexp (pf | out, hie_val);
prstr ")"
end | HIEassgn_var (d2v, hils, hie_val) => begin
prstr "HIEassgn_var(";
fprint_d2var (pf | out, d2v);
prstr "; ";
fprint_hilablst (pf | out, hils);
prstr "; ";
fprint_hiexp (pf | out, hie_val);
prstr ")"
end | HIEbool b => begin
prstr "HIEbool("; fprint1_bool (pf | out, b); prstr ")"
end | HIEcaseof _ => begin
prstr "HIEcaseof("; fprint1_string (pf | out, "..."); prstr ")"
end | HIEcastfn (d2c, hie) => begin
prstr "HIEcastfn(";
fprint_d2cst (pf | out, d2c); prstr "; "; fprint_hiexp (pf | out, hie);
prstr ")"
end | HIEchar c => begin
prstr "HIEchar("; fprint1_char (pf | out, c); prstr ")"
end | HIEcon (hit_sum, d2c, hies_arg) => begin
prstr "HIEcon(";
fprint_hityp (pf | out, hit_sum);
prstr "; ";
fprint_d2con (pf | out, d2c);
prstr "; ";
fprint_hiexplst (pf | out, hies_arg);
prstr ")"
end | HIEcst d2c => begin
prstr "HIEcst("; fprint_d2cst (pf | out, d2c); prstr ")"
end | HIEcstsp cst => begin
prstr "HIEcstsp("; $Syn.fprint_cstsp (pf | out, cst); prstr ")"
end | HIEdynload fil => begin
prstr "HIEdynload(";
$Fil.fprint_filename (pf | out, fil);
prstr ")";
end | HIEempty () => begin
fprint1_string (pf | out, "HIEempty()")
end | HIEextval code => begin
prstr "HIEextval("; fprint1_string (pf | out, code); prstr ")"
end | HIEfix (knd, d2v_fun, hie_body) => begin
prstr "HIEfix(";
fprint1_int (pf | out, knd);
prstr "; ";
fprint_d2var (pf | out, d2v_fun);
prstr "; ";
fprint_hiexp (pf | out, hie_body);
prstr ")"
end | HIEfloat f => begin
prstr "HIEfloat("; fprint1_string (pf | out, f); prstr ")"
end
| HIEfloatsp f => begin
prstr "HIEfloatsp("; fprint1_string (pf | out, f); prstr ")"
end
| HIEfreeat hie => begin
prstr "HIEfreeat("; fprint_hiexp (pf | out, hie); prstr ")"
end
| HIEif (hie_cond, hie_then, hie_else) => begin
prstr "HIEif(";
fprint_hiexp (pf | out, hie_cond);
prstr "; ";
fprint_hiexp (pf | out, hie_then);
prstr "; ";
fprint_hiexp (pf | out, hie_else);
prstr ")"
end | HIEint (str, int) => begin
prstr "HIEint(";
$IntInf.fprint_intinf (pf | out, int);
prstr ")"
end | HIEintsp (str, int) => begin
prstr "HIEintsp("; fprint1_string (pf | out, str); prstr ")"
end
| HIElam (hips_arg, hie_body) => begin
prstr "HIElam(";
fprint_hipatlst (pf | out, hips_arg);
prstr "; ";
fprint_hiexp (pf | out, hie_body);
prstr ")"
end | HIElaminit (hips_arg, hie_body) => begin
prstr "HIElaminit(";
fprint_hipatlst (pf | out, hips_arg);
prstr "; ";
fprint_hiexp (pf | out, hie_body);
prstr ")"
end | HIElazy_delay (hie_eval) => begin
prstr "HIElazy_delay(";
fprint_hiexp (pf | out, hie_eval);
prstr ")"
end | HIElazy_vt_delay (hie_eval, hie_free) => begin
prstr "HIElazy_delay(";
fprint_hiexp (pf | out, hie_eval);
prstr "; ";
fprint_hiexp (pf | out, hie_free);
prstr ")"
end | HIElazy_force (lin, hie_lazy) => begin
prstr "HIElazy_force(";
fprint_int (pf | out, lin);
prstr "; ";
fprint_hiexp (pf | out, hie_lazy);
prstr ")"
end | HIElet (hids, hie) => begin
prstr "HIElet(";
fprint1_string (pf | out, "...");
prstr "; ";
fprint_hiexp (pf | out, hie);
prstr ")"
end | HIEloop (ohie_init, hie_test, ohie_post, hie_body) => begin
prstr "HIEloop(";
begin case+ ohie_post of
| None () => () | Some hie => fprint_hiexp (pf | out, hie)
end;
prstr "; ";
fprint_hiexp (pf | out, hie_test);
prstr "; ";
begin case+ ohie_post of
| None () => () | Some hie => fprint_hiexp (pf | out, hie)
end;
prstr "; ";
fprint_hiexp (pf | out, hie_body);
prstr ")"
end | HIEloopexn i => begin
prstr "HIEloopexn("; fprint1_int (pf | out, i); prstr ")"
end | HIElst (lin, hit, hies) => begin
prstr "HIElst(";
fprint1_int (pf | out, lin);
prstr "; ";
fprint_hityp (pf | out, hit);
prstr "; ";
fprint_hiexplst (pf | out, hies);
prstr ")"
end | HIEptrof_ptr (hie, hils) => begin
prstr "HIEptrof_ptr(";
fprint_hiexp (pf | out, hie);
prstr "; ";
fprint_hilablst (pf | out, hils);
prstr ")"
end | HIEptrof_var (d2v, hils) => begin
prstr "HIEptrof_var(";
fprint_d2var (pf | out, d2v);
prstr "; ";
fprint_hilablst (pf | out, hils);
prstr ")"
end | HIEraise (hie) => begin
prstr "HIEraise("; fprint_hiexp (pf | out, hie); prstr ")"
end | HIErec (knd, hit_rec, lhies) => begin
prstr "HIErec(";
fprint1_int (pf | out, knd);
prstr "; ";
fprint_hityp (pf | out, hit_rec);
prstr "; ";
fprint_labhiexplst (pf | out, lhies);
prstr ")"
end | HIErefarg (refval, freeknd, hie_arg) => begin
prstr "HIErefarg(";
fprint1_int (pf | out, refval);
prstr "; ";
fprint1_int (pf | out, freeknd);
prstr "; ";
fprint_hiexp (pf | out, hie_arg);
prstr ")"
end | HIEsel (hie, hils) => begin
prstr "HIEsel(";
fprint_hiexp (pf | out, hie);
prstr "; ";
fprint_hilablst (pf | out, hils);
prstr ")"
end | HIEsel_ptr (hie, hils) => begin
prstr "HIEsel_ptr(";
fprint_hiexp (pf | out, hie);
prstr "; ";
fprint_hilablst (pf | out, hils);
prstr ")"
end | HIEsel_var (d2v, hils) => begin
prstr "HIEsel_var(";
fprint_d2var (pf | out, d2v);
prstr "; ";
fprint_hilablst (pf | out, hils);
prstr ")"
end | HIEseq (hies) => begin
prstr "HIEseq("; fprint_hiexplst (pf | out, hies); prstr ")"
end | HIEsif (hie_then, hie_else) => begin
prstr "HIEsif(";
fprint_hiexp (pf | out, hie_then);
prstr ", ";
fprint_hiexp (pf | out, hie_else);
prstr ")"
end | HIEsizeof (hit) => begin
prstr "HIEsizeof("; fprint_hityp (pf | out, hit); prstr ")"
end | HIEstring (str, len) => begin
fprint1_string (pf | out, "HIEstring(...)")
end | HIEtmpcst (d2c, hitss) => begin
prstr "HIEtmpcst(";
fprint_d2cst (pf | out, d2c);
prstr "; ";
fprint_hityplstlst (pf | out, hitss);
prstr ")"
end | HIEtmpvar (d2v, hitss) => begin
prstr "HIEtmpvar(";
fprint_d2var (pf | out, d2v);
prstr "; ";
fprint_hityplstlst (pf | out, hitss);
prstr ")"
end | HIEtop () => begin
fprint1_string (pf | out, "HIEtop()")
end | HIEtrywith _ => begin
fprint1_string (pf | out, "HIEtrywith(...)")
end | HIEvar d2v => begin
prstr "HIEvar("; fprint_d2var (pf | out, d2v); prstr ")"
end end
implement
fprint_hiexplst {m}
(pf | out, hies0) = let
fun aux (
out: &FILE m, i: int, hies: hiexplst
) : void =
case+ hies of
| list_cons (hie, hies) => begin
if i > 0 then fprint1_string (pf | out, ", ");
fprint_hiexp (pf | out, hie); aux (out, i+1, hies)
end | list_nil () => () in
aux (out, 0, hies0)
end
implement
fprint_hiexplstlst {m}
(pf | out, hiess0) = let
fun aux (
out: &FILE m, i: int, hiess: hiexplstlst
) : void =
case+ hiess of
| list_cons (hies, hiess) => begin
if i > 0 then fprint1_string (pf | out, "; ");
fprint_hiexplst (pf | out, hies); aux (out, i+1, hiess)
end | list_nil () => () in
aux (out, 0, hiess0)
end
implement
fprint_labhiexplst {m}
(pf | out, lhies0) = let
fun aux (
out: &FILE m, i: int, lhies: labhiexplst
) : void =
case+ lhies of
| LABHIEXPLSTcons (l, hie, lhies) => begin
if i > 0 then fprint1_string (pf | out, ", ");
fprint_label (pf | out, l);
fprint1_string (pf | out, "= ");
fprint_hiexp (pf | out, hie);
aux (out, i+1, lhies)
end | LABHIEXPLSTnil () => () in
aux (out, 0, lhies0)
end
implement
fprint_hilab (pf | out, hil) = let
macdef prstr (s) = fprint1_string (pf | out, ,(s))
in
case+ hil.hilab_node of
| HILlab (l, s2e_rec) => begin
prstr "HILlab("; fprint_label (pf | out, l); prstr ")"
end | HILind (hiess, s2e_elt) => begin
prstr "HILind("; fprint_hiexplstlst (pf | out, hiess); prstr ")"
end end
implement
fprint_hilablst {m}
(pf | out, hils0) = let
fun aux (
out: &FILE m, i: int, hils: hilablst
) : void =
case+ hils of
| list_cons (hil, hils) => begin
if i > 0 then fprint1_string (pf | out, ", ");
fprint_hilab (pf | out, hil); aux (out, i+1, hils)
end | list_nil () => () in
aux (out, 0, hils0)
end
implement
print_hiexp (hie) = print_mac (fprint_hiexp, hie)
implement
prerr_hiexp (hie) = prerr_mac (fprint_hiexp, hie)
implement
print_hiexplst (hies) = print_mac (fprint_hiexplst, hies)
implement
prerr_hiexplst (hies) = prerr_mac (fprint_hiexplst, hies)
implement
fprint_vartyp (pf | out, vtp) = begin
fprint_d2var (pf | out, vartyp_var_get vtp);
fprint1_string (pf | out, "(");
fprint_hityp (pf | out, hityp_decode (vartyp_typ_get vtp));
fprint1_string (pf | out, ")")
end
implement
print_vartyp (vtp) = print_mac (fprint_vartyp, vtp)
implement
prerr_vartyp (vtp) = prerr_mac (fprint_vartyp, vtp)