Updating: very minorly improving

Updating: very minorly improving

(* ****** ****** *)
//
// ATS-parse-emit-js
//
(* ****** ****** *)
//
// HX-2014-08-20: start
//
(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
staload "./atsparemit.sats"
staload "./atsparemit_syntax.sats"
//
(* ****** ****** *)
//
staload "./atsparemit_emit.sats"
//
(* ****** ****** *)
//
staload "./atsparemit_typedef.dats"
//
(* ****** ****** *)
//
extern
fun
emit_tmpdeclst_initize
(
  out: FILEref, tds: tmpdeclst
) : void // end-of-fun
//
implement
emit_tmpdeclst_initize
  (out, tds) = let
//
fun auxlst
(
  out: FILEref, tds: tmpdeclst
) : void = let
in
//
case+ tds of
| list_nil () => ()
| list_cons (td, tds) =>
  (
    case+ td.tmpdec_node of
    | TMPDECnone
        (tmp) => auxlst (out, tds)
    | TMPDECsome
        (tmp, _) => let
        val () = emit_nspc (out, 2(*ind*))
        val () =
        (
          emit_text (out, "var "); emit_tmpvar (out, tmp); emit_ENDL (out)
        ) (* end of [val] *)
      in
        auxlst (out, tds)
      end // end of [TMPDECsome]
  ) (* end of [list_cons] *)
//
end // end of [auxlst]
//
in
  auxlst (out, tds)
end // end of [emit_tmpdeclst_initize]
//
(* ****** ****** *)
//
extern
fun
the_tmpdeclst_get (): tmpdeclst
extern
fun
the_tmpdeclst_set (tds: tmpdeclst): void
//
(* ****** ****** *)
//
extern
fun
the_funbodylst_get (): instrlst
extern
fun
the_funbodylst_set (inss: instrlst): void
//
(* ****** ****** *)
//
extern
fun
the_branchlablst_get (): labelist
extern
fun
the_branchlablst_set (tls: labelist): void
extern
fun
the_branchlablst_unset ((*void*)): void
//
(* ****** ****** *)

local
//
val the_tmpdeclst = ref<tmpdeclst> (list_nil)
//
val the_funbodylst = ref<instrlst> (list_nil)
//
// HX: this is a stack:
//
val the_branchlablstlst = ref<List0(labelist)> (list_nil)
//
in (* in-of-local *)

implement
the_tmpdeclst_get () = !the_tmpdeclst
implement
the_tmpdeclst_set (xs) = !the_tmpdeclst := xs

implement
the_funbodylst_get () = !the_funbodylst
implement
the_funbodylst_set (xs) = !the_funbodylst := xs

implement
the_branchlablst_get
(
) = let
//
val xss = !the_branchlablstlst
//
in
//
case- xss of list_cons (xs, _) => xs
//
end // end of [the_branchlablst_get]

implement
the_branchlablst_set
(
  xs
) = let
//
val xss = !the_branchlablstlst
//
in
  !the_branchlablstlst := list_cons (xs, xss)
end // end of [the_branchlablst_set]

implement
the_branchlablst_unset
(
) = let
//
val xss = !the_branchlablstlst
//
in
//
case- xss of
| list_cons (_, xss) => !the_branchlablstlst := xss
//
end // end of [the_branchlablst_unset]

end // end of [local]

(* ****** ****** *)
//
extern
fun
funlab_get_index (fl: label): int
extern
fun
tmplab_get_index (lab: label): int
//
(* ****** ****** *)

implement
funlab_get_index
  (fl0) = let
//
val n0 = fl0.i0de_sym
//
fun
auxlst
(
  xs: instrlst, i: int
) : int = (
//
case+ xs of
| list_nil () => ~1(*error*)
| list_cons (x, xs) =>
  (
    case+ x.instr_node of
    | ATSfunbodyseq _ => let
        val fl = funbodyseq_get_funlab (x)
      in
        if n0 = fl.i0de_sym then i else auxlst (xs, i+1)
      end // end of [ATSfunbodyseq]
    | _ (*non-ATSfunbody*) => auxlst (xs, i)
  ) (* end of [list_cons] *)
//
) (* end of [auxlst] *)
//
in
  auxlst (the_funbodylst_get(), 1)
end // end of [funlab_get_index]

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

implement
tmplab_get_index
  (lab0) = let
//
val n0 = lab0.i0de_sym
//
fun
auxlst
(
  xs: labelist, i: int
) : int =
(
case+ xs of
| list_nil () => ~1(*error*)
| list_cons (x, xs) =>
    if n0 = x.i0de_sym then i else auxlst (xs, i+1)
  // end of [list_cons]
)
//
in
  auxlst (the_branchlablst_get(), 1)
end // end of [tmplab_get_index]

(* ****** ****** *)
//
fun
emit_funlab_index
 (out: FILEref, fl: label): void =
 emit_int (out, funlab_get_index (fl))
//
fun
emit_tmplab_index
 (out: FILEref, lab: label): void =
 emit_int (out, tmplab_get_index (lab))
//
(* ****** ****** *)
//
extern
fun emit2_instr
  (out: FILEref, ind: int, ins: instr) : void
//
extern
fun emit2_instr_ln
  (out: FILEref, ind: int, ins: instr) : void
//
extern
fun emit2_instrlst
  (out: FILEref, ind: int, inss: instrlst) : void
//
(* ****** ****** *)
//
extern
fun emit2_branchseqlst
  (out: FILEref, ind: int, inss: instrlst): void
//
(* ****** ****** *)
//
extern
fun emit2_ATSfunbodyseq
  (out: FILEref, ind: int, ins: instr) : void
//
extern
fun emit2_ATSINSmove_con1
  (out: FILEref, ind: int, ins: instr) : void
extern
fun emit2_ATSINSmove_boxrec
  (out: FILEref, ind: int, ins: instr) : void
//
(* ****** ****** *)
//
// HX-2014-08:
// this one should not be used for
// emitting multiple-line instructions
//
implement
emit_instr
  (out, ins) = emit2_instr (out, 0(*ind*), ins)
//
(* ****** ****** *)

implement
emit2_instr
  (out, ind, ins0) = let
in
//
case+
ins0.instr_node of
//
| ATSif
  (
    d0e, inss, inssopt
  ) => let
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "if")
    val () = emit_LPAREN (out)
    val () = emit_d0exp (out, d0e)
    val () = emit_RPAREN (out)
    val () = emit_text (out, " {\n")
    val () = emit2_instrlst (out, ind+2, inss)
  in
    case+ inssopt of
    | None _ =>
      {
        val () = emit_nspc (out, ind)
        val () = emit_text (out, "} // endif")
      } (* end of [None] *)
    | Some (inss) =>
      {
        val () = emit_nspc (out, ind)
        val () = emit_text (out, "} else {\n")
        val () = emit2_instrlst (out, ind+2, inss)
        val () = emit_nspc (out, ind)
        val ((*closing*)) = emit_text (out, "} // endif")
      } (* end of [Some] *)
  end // end of [ATSif]
//
| ATSifthen (d0e, inss) =>
  {
//
    val-list_cons (ins, _) = inss
//
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "if(")
    val () = emit_d0exp (out, d0e)
    val () = emit_text (out, ") ")
    val () = emit_instr (out, ins)
  }
//
| ATSifnthen (d0e, inss) =>
  {
//
    val-list_cons (ins, _) = inss
//
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "if(!")
    val () = emit_d0exp (out, d0e)
    val ((*closing*)) = emit_text (out, ") ")
    val () = emit_instr (out, ins)
  }
//
| ATSbranchseq (inss) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATSbranchseq(...)")
  }
//
| ATScaseofseq (inss) =>
  {
//
    val tls =
      caseofseq_get_tmplablst (ins0)
    // end of [val]
    val () = the_branchlablst_set (tls)
//
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATScaseofseq_beg")
    val () = emit_ENDL (out)
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "tmplab_js = 1;")
    val () = emit_ENDL (out)
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "while(true) {")
    val () = emit_ENDL (out)
    val () = emit_nspc (out, ind+2)
    val () = emit_text (out, "tmplab = tmplab_js; tmplab_js = 0;")
    val () = emit_ENDL (out)
    val () = emit_nspc (out, ind+2)
    val () = emit_text (out, "switch(tmplab) {\n")
//
    val () = emit2_branchseqlst (out, ind+4, inss)
//
    val () = emit_nspc (out, ind+2)
    val () = emit_text (out, "} // end-of-switch\n")
//
    val () = emit_nspc (out, ind+2)
    val () =
      emit_text (out, "if (tmplab_js === 0) break;\n")
    // end of [val]
//
    val () = emit_nspc (out, ind)
    val ((*closing*)) = emit_text (out, "} // endwhile\n")
//
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATScaseofseq_end")
//
    val () = the_branchlablst_unset ((*void*))
//
  } (* end of [ATScaseofseq] *)
//
| ATSreturn (tmp) =>
  {
    val () = emit_nspc (out, ind)
    val () =
      emit_text (out, "return ")
    val () = emit_tmpvar (out, tmp)
    val () = emit_SEMICOLON (out)
  }
| ATSreturn_void (tmp) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "return/*_void*/")
    val () = emit_SEMICOLON (out)
  }
//
| ATSINSlab (lab) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "case ")
    val () =
    (
      emit_tmplab_index (out, lab); emit_COLON (out)
    ) (* end of [val] *)
    val () =
    (
      emit_text (out, " // "); emit_label (out, lab)
    ) (* end of [val] *)
  } (* end of [ATSINSlab] *)
//
| ATSINSgoto (lab) =>
  {
    val () = emit_nspc (out, ind)
    val () =
      emit_text (out, "{ tmplab_js = ")
    // end of [val]
    val () = emit_tmplab_index (out, lab)
    val ((*closing*)) = emit_text (out, "; break; }")
  } (* end of [ATSINSgoto] *)
//
| ATSINSflab (flab) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ")
    val () = emit_label (out, flab)
  } (* end of [ATSINSflab] *)
//
| ATSINSfgoto (flab) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "funlab_js = ")
    val () = emit_funlab_index (out, flab)
    val () = (
      emit_text (out, "; // "); emit_label (out, flab)
    ) (* end of [val] *)
  } (* end of [ATSINSfgoto] *)
//
| ATSINSmove (tmp, d0e) =>
  {
    val () = emit_nspc (out, ind)
    val () = (
      emit_tmpvar (out, tmp);
      emit_text (out, " = "); emit_d0exp (out, d0e)
    ) (* end of [val] *)
    val () = emit_SEMICOLON (out)
  } (* end of [ATSINSmove] *)
//
| ATSINSmove_void
    (tmp, d0e(*command*)) => let
    val () = emit_nspc (out, ind)
  in
    case+ d0e.d0exp_node of
    | ATSempty _ =>
        emit_text (out, "// ATSINSmove_void")
      // end of [ATSempty]
    | _ (*non-ATSempty*) =>
        (emit_d0exp (out, d0e); emit_SEMICOLON (out))
  end (* end of [ATSINSmove_void] *)
//
| ATSINSmove_nil (tmp) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_tmpvar (out, tmp)
    val () = emit_text (out, " = ")
    val () = emit_text (out, "null")
    val () = emit_SEMICOLON (out)
  }
| ATSINSmove_con0 (tmp, tag) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_tmpvar (out, tmp)
    val () = emit_text (out, " = ")
    val () = emit_PMVint (out, tag)
    val () = emit_SEMICOLON (out)
  }
//
| ATSINSmove_con1 _ =>
    emit2_ATSINSmove_con1 (out, ind, ins0)
| ATSINSmove_boxrec _ =>
    emit2_ATSINSmove_boxrec (out, ind, ins0)
//
| ATStailcalseq (inss) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATStailcalseq_beg")
    val () = emit_ENDL (out)
    val () = emit2_instrlst (out, ind, inss)
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATStailcalseq_end")

  } (* end of [ATStailcalseq] *)
//
| ATSINSmove_tlcal (tmp, d0e) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_tmpvar (out, tmp)
    val () = emit_text (out, " = ")
    val () = emit_d0exp (out, d0e)
    val () = emit_SEMICOLON (out)
  } (* end of [ATSINSmove_tlcal] *)
//
| ATSINSargmove_tlcal (tmp1, tmp2) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_tmpvar (out, tmp1)
    val () = emit_text (out, " = ")
    val () = emit_tmpvar (out, tmp2)
    val () = emit_SEMICOLON (out)
  } (* end of [ATSINSargmove_tlcal] *)
//
| ATSdynload (dummy) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATSdynload()")
  }
//
| ATSdynload0 (flag) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "var\n")
    val () = (
      emit_tmpvar (out, flag); emit_text (out, " = 0 ;")
    ) (* end of [val] *)
  }
| ATSdynload1 (flag) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATSdynload1(...)")
  }
//
| ATSdynloadset (flag) =>
  {
    val () = emit_nspc (out, ind)
    val () = (
      emit_tmpvar (out, flag); emit_text (out, " = 1 ; // flag is set")
    ) (* end of [val] *)
  }
//
| _ (*rest-of-instr*) =>
  {
    val () = emit_nspc (out, ind)
    val ((*error*)) = fprint! (out, "UNRECOGNIZED-INSTRUCTION: ", ins0)
  }
//
end // end of [emit2_instr]

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

implement
emit2_instr_ln
  (out, ind, ins) =
(
  emit2_instr (out, ind, ins); emit_ENDL (out)
) (* end of [emit2_instr_ln] *)

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

implement
emit2_instrlst
(
  out, ind, inss
) = (
//
case+ inss of
| list_nil () => ()
| list_cons (ins, inss) =>
  {
    val () = emit2_instr_ln (out, ind, ins)
    val () = emit2_instrlst (out, ind, inss)
  }
//
) (* end of [emit2_instrlst] *)

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

implement
emit2_branchseqlst
  (out, ind, inss) = let
//
fun auxseq
(
  out: FILEref
, ind: int, ins0: instr
) : void = let
in
//
case-
ins0.instr_node of
//
| ATSbranchseq
    (inss) => emit2_instrlst (out, ind, inss)
  // end of [ATSbranchseq]
//
end (* end of [auxseq] *)
//
fun auxseqlst
(
  out: FILEref
, ind: int, inss: instrlst
) : void = let
in
//
case+ inss of
| list_nil () => ()
| list_cons
    (ins, inss) => let
//
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATSbranchseq_beg\n")
//
    val () = auxseq (out, ind, ins)
//
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "break;\n")
//
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATSbranchseq_end\n")
//
  in
    auxseqlst (out, ind, inss)
  end (* end of [list_cons] *)
//
end (* end of [auxseqlst] *)
//
in
  auxseqlst (out, ind, inss)
end // end of [emit2_branchseqlst]

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

implement
emit2_ATSfunbodyseq
  (out, ind, ins) = let
//
val-ATSfunbodyseq (inss) = ins.instr_node
//
in
  emit2_instrlst (out, ind, inss)
end // end of [emit2_ATS2funbodyseq]

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

implement
emit2_ATSINSmove_con1
  (out, ind, ins0) = let
//
fun
getarglst
(
  inss: instrlst
) : d0explst =
(
case+ inss of
| list_nil () => list_nil ()
| list_cons (ins, inss) => let
    val-ATSINSstore_con1_ofs (_, _, _, d0e) = ins.instr_node
    val d0es = getarglst (inss)
  in
    list_cons (d0e, d0es)
  end // end of [list_cons]
)
//
val-ATSINSmove_con1 (inss) = ins0.instr_node
//
val-list_cons (ins, inss) = inss
val-ATSINSmove_con1_new (tmp, _) = ins.instr_node
//
var opt: tokenopt = None()
//
val inss =
(
case+ inss of
| list_nil () => inss
| list_cons (ins, inss2) =>
  (
    case+ ins.instr_node of
    | ATSINSstore_con1_tag
        (tmp, tag) => let
        val () = opt := Some(tag) in inss2
      end // end of [ATSINSstore_con1_tag]
    | _ (*non-ATSINSstore_con1_tag*) => inss
  )
) : instrlst
//
val d0es = getarglst (inss)
val () = emit_nspc (out, ind)
val () = emit_tmpvar (out, tmp)
val () = emit_text (out, " = ")
val () = emit_LBRACKET (out)
val () =
(
case+ opt of
| None () => ()
| Some (tag) => emit_PMVint (out, tag)
) : void // end of [val]
val () =
(
case+ opt of
| None _ => emit_d0explst (out, d0es)
| Some _ => emit_d0explst_1 (out, d0es)
) : void // end of [val]
//
val () = emit_RBRACKET (out)
//
val () = emit_SEMICOLON (out)
//
in
  // nothing
end // end of [emit2_ATSINSmove_con1]

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

implement
emit2_ATSINSmove_boxrec
  (out, ind, ins0) = let
//
fun
getarglst
(
  inss: instrlst
) : d0explst =
(
case+ inss of
| list_nil () => list_nil ()
| list_cons (ins, inss) => let
    val-ATSINSstore_boxrec_ofs (_, _, _, d0e) = ins.instr_node
    val d0es = getarglst (inss)
  in
    list_cons (d0e, d0es)
  end // end of [list_cons]
)
//
val-ATSINSmove_boxrec (inss) = ins0.instr_node
//
val-list_cons (ins, inss) = inss
val-ATSINSmove_boxrec_new (tmp, _) = ins.instr_node
//
val d0es = getarglst (inss)
//
val () = emit_nspc (out, ind)
val () = emit_tmpvar (out, tmp)
val () = emit_text (out, " = ")
val () = emit_LBRACKET (out)
val () = emit_d0explst (out, d0es)
val () = emit_RBRACKET (out)
//
val () = emit_SEMICOLON (out)
//
in
  // nothing
end // end of [emit2_ATSINSmove_boxrec]

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

#define
ATSEXTCODE_BEG "/* ATSextcode_beg() */"
#define
ATSEXTCODE_END "/* ATSextcode_end() */"

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

implement
emit_d0ecl
  (out, d0c) = let
in
//
case+
d0c.d0ecl_node of
//
| D0Cinclude _ => ()
//
| D0Cifdef _ => ()
| D0Cifndef _ => ()
//
| D0Ctypedef (id, def) =>
    typedef_insert (id.i0de_sym, def)
  // end of [D0Ctypedef]
//
| D0Cdyncst_mac _ => ()
| D0Cdyncst_extfun _ => ()
//
| D0Cextcode (toks) =>
  {
    val () = emit_ENDL (out)
    val () =
      emit_text (out, ATSEXTCODE_BEG)
    val () = emit_extcode (out, toks) // HX: verbatim output
    val () =
      emit_text (out, ATSEXTCODE_END)
    val ((*void*)) = emit_newline (out)
  } (* end of [D0Cextcode] *)
//
| D0Cstatmp
    (tmp, opt) =>
  {
    val () = emit_ENDL (out)
    val () = (
      case+ opt of
      | Some _ => () | None () => emit_text(out, "/*\n")
    ) (* end of [val] *)
    val () = (
      emit_text (out, "var "); emit_tmpvar (out, tmp); emit_ENDL (out)
    ) (* end of [val] *)
    val () = (
      case+ opt of
      | Some _ => () | None () => emit_text(out, "*/\n")
    ) (* end of [val] *)
  } (* end of [D0Cstatmp] *)
//
| D0Cfundecl (fk, f0d) => emit_f0decl (out, f0d)
//
| D0Cclosurerize
    (fl, env, arg, res) =>
  {
    val () = emit_closurerize (out, fl, env, arg, res)
  }
//
end // end of [emit_d0ecl]

(* ****** ****** *)
//
extern
fun emit_f0arg : emit_type (f0arg)
extern
fun emit_f0marg : emit_type (f0marg)
extern
fun emit_f0head : emit_type (f0head)
//
extern
fun emit_f0body : emit_type (f0body)
extern
fun emit_f0body_0 : emit_type (f0body)
extern
fun emit_f0body_tlcal : emit_type (f0body)
extern
fun emit_f0body_tlcal2 : emit_type (f0body)
//
(* ****** ****** *)

implement
emit_f0arg
  (out, f0a) = let
in
//
case+
f0a.f0arg_node of
//
| F0ARGnone _ => emit_text (out, "__NONE__")
| F0ARGsome (arg, s0e) => emit_tmpvar (out, arg)
//
end // end of [emit_f0arg]

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

implement
emit_f0marg
  (out, f0ma) = let
//
fun
loop
(
  out: FILEref, f0as: f0arglst, i: int
) : void =
(
case+ f0as of
| list_nil () => ()
| list_cons (f0a, f0as) => let
    val () =
      if i > 0 then emit_text (out, ", ")
    // end of [val]
  in
    emit_f0arg (out, f0a); loop (out, f0as, i+1)
  end // end of [list_cons]
)
//
in
  loop (out, f0ma.f0marg_node, 0)
end // end of [emit_f0marg]

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

implement
emit_f0head
  (out, fhd) = let
//
val f0as =
  f0head_get_f0arglst (fhd)
//
in
//
case+
fhd.f0head_node of
| F0HEAD
    (fid, f0ma, res) =>
  {
//
    val () = emit_i0de (out, fid)
//
    val () = emit_LPAREN (out)
    val () = emit_f0marg (out, f0ma)
    val () = emit_RPAREN (out)
//
  }
//
end // end of [emit_f0head]

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

implement
emit_f0body
  (out, fbody) = let
//
val knd = f0body_classify (fbody)
(*
val () =
println! ("emit_f0body: knd = ", knd)
*)
//
val tmpdecs =
  f0body_get_tmpdeclst (fbody)
val inss_body =
  f0body_get_bdinstrlst (fbody)
//
val () = the_tmpdeclst_set (tmpdecs)
val () = the_funbodylst_set (inss_body)
//
val () = emit_text (out, "{\n")
//
val () = emit_text (out, "//\n")
val () = emit_text (out, "// knd = ")
val () = (emit_int (out, knd); emit_ENDL (out))
//
val () =
  emit_tmpdeclst_initize (out, tmpdecs)
//
val () =
if knd > 0 then
{
//
val () = emit_nspc (out, 2)
val () = emit_text (out, "var funlab_js\n")
//
val () = emit_nspc (out, 2)
val () = emit_text (out, "var tmplab, tmplab_js\n")
//
} (* end of [if] *) // end of [val]
//
val () = emit_text (out, "//\n")
//
val () = (
//
case+ knd of
| 1 => emit_f0body_tlcal (out, fbody)
| 2 => emit_f0body_tlcal2 (out, fbody)
| _ (*0*) => emit_f0body_0 (out, fbody)
//
) : void // end of [val]
//
val () = emit_text (out, "} // end-of-function\n")
//
in
  // nothing
end (* end of [emit_f0body] *)

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

implement
emit_f0body_0
  (out, fbody) = let
//
fun
auxlst
(
  out: FILEref, inss: instrlst, i: int
) : void =
(
case+ inss of
| list_nil () => ()
| list_cons
    (ins0, inss1) => let
    val-list_cons (ins1, inss2) = inss1
//
    val () = if i > 0 then emit_ENDL (out)
    val () = emit2_ATSfunbodyseq (out, 2(*ind*), ins0)
    val ((*return*)) = emit2_instr_ln (out, 2(*ind*), ins1)
//
  in
    auxlst (out, inss2, i+1)
  end // end of [list_cons]
//
) (* end of [auxlst] *)
//
in
//
case+
fbody.f0body_node of
//
| F0BODY (tds, inss) =>
  {
    val () = auxlst (out, inss, 0(*i*))
  }
//
end // end of [emit_f0body_0]

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

implement
emit_f0body_tlcal
  (out, fbody) = let
//
fun
auxlst
(
  out: FILEref, inss: instrlst
) : void =
(
case+ inss of
| list_nil () => ()
| list_cons
    (ins0, inss1) => let
    val-list_cons (ins1, inss2) = inss1
//
    val () =
    emit2_ATSfunbodyseq (out, 4(*ind*), ins0)
//
    val () = emit_nspc (out, 4(*ind*))
    val () =
    emit_text
    (
      out, "if (funlab_js > 0) continue; else"
    ) (* end of [val] *)
    val () = emit2_instr_ln (out, 1(*ind*), ins1)
//
    val () = emit_nspc (out, 2(*ind*))
    val () = emit_text (out, "} // endwhile-fun\n")
//
  in
    auxlst (out, inss2(*nil*))
  end // end of [list_cons]
//
) (* end of [auxlst] *)
//
val () = emit_nspc (out, 2(*ind*))
val () = emit_text (out, "while(true) {\n")
val () = emit_nspc (out, 4(*ind*))
val () = emit_text (out, "funlab_js = 0;\n")
//
val () =
(
case+
fbody.f0body_node of
//
| F0BODY (tds, inss) => auxlst (out, inss)
//
) (* end of [val] *)
//
in
  // nothing
end // end of [emit_f0body_tlcal]

(* ****** ****** *)
//
extern
fun
emit_the_funbodylst
  (out: FILEref): void
//
implement
emit_the_funbodylst
  (out) = let
//
fun auxfun
(
  out: FILEref
, ins0: instr, ins1: instr, i: int
) : void = let
//
val-ATSfunbodyseq(inss) = ins0.instr_node
//
val-list_cons (ins_fl, inss) = inss
val-ATSINSflab (fl) = ins_fl.instr_node
//
val () = emit_nspc (out, 6)
val () =
(
  emit_text (out, "case ");
  emit_int (out, i); emit_text (out, ": {")
)
val () = emit_ENDL (out)
val () = emit_nspc (out, 8)
val () = emit_text (out, "funlab_js = 0;\n")
val () = emit2_instrlst (out, 8(*ind*), inss)
//
val () = emit_nspc (out, 8)
val () =
emit_text
(
  out, "if (funlab_js > 0) continue; else"
) (* end of [val] *)
val () = emit2_instr_ln (out, 1(*ind*), ins1)
//
val () = emit_nspc (out, 6)
val () = emit_text (out, "} // end-of-case\n")
//
in
  // nothing
end // end of [auxfun]
//
fun auxlst
(
  out: FILEref, inss: instrlst, i: int
) : void =
(
case+ inss of
| list_nil () => ()
| list_cons _ => let
    val-list_cons (ins0, inss) = inss
    val-list_cons (ins1, inss) = inss
    val () = auxfun (out, ins0, ins1, i)
  in
    auxlst (out, inss, i+1)
  end // end of [auxlst]
) (* end of [auxlst] *)
//
in
  auxlst (out, the_funbodylst_get((*void*)), 1(*i*))
end // end of [emit_the_funbodylst]
//
(* ****** ****** *)

implement
emit_f0body_tlcal2
  (out, fbody) = let
//
val () = emit_nspc (out, 2(*ind*))
val () = emit_text (out, "funlab_js = 1;")
//
val () = emit_ENDL (out)
val () = emit_nspc (out, 2(*ind*))
val () = emit_text (out, "while(true) {")
//
val () = emit_ENDL (out)
val () = emit_nspc (out, 4(*ind*))
val () = emit_text (out, "switch(funlab_js) {\n")
//
val () = emit_the_funbodylst (out)
//
val () = emit_nspc (out, 4(*ind*))
val ((*closing*)) = emit_text (out, "} // end-of-switch\n")
//
val () = emit_nspc (out, 2(*ind*))
val ((*closing*)) = emit_text (out, "} // endwhile-fun\n")
//
in
  // nothing
end // end of [emit_f0body_tlcal2]

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

implement
emit_f0decl
  (out, fdec) = let
in
//
case+
fdec.f0decl_node of
| F0DECLnone (fhd) => ()
| F0DECLsome (fhd, fbody) =>
  {
    val () = emit_ENDL (out)
    val () = emit_text (out, "function")
    val () = emit_ENDL (out)
    val () = emit_f0head (out, fhd)
    val () = emit_ENDL (out)
    val () = emit_f0body (out, fbody)
    val () = emit_newline (out)
  } (* end of [F0DECLsome] *)
//
end // end of [emit_f0decl]

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

implement
emit_toplevel
  (out, d0cs) = let
//
fun
loop
(
  out: FILEref, d0cs: d0eclist
) : void =
(
//
case+ d0cs of
| list_nil () => ()
| list_cons
    (d0c, d0cs) => let
    val () =
      emit_d0ecl (out, d0c)
    // end of [val]
  in
    loop (out, d0cs)
  end // end of [list_cons]
//
)
//
in
  loop (out, d0cs)
end // end of [emit_toplevel]

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

(* end of [atsparemit_emit2_js.dats] *)

(* ****** ****** *)
//
// ATS-parse-emit-js
//
(* ****** ****** *)
//
// HX-2014-08-20: start
//
(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
staload "./atsparemit.sats"
staload "./atsparemit_syntax.sats"
//
(* ****** ****** *)
//
staload "./atsparemit_emit.sats"
//
(* ****** ****** *)
//
staload "./atsparemit_typedef.dats"
//
(* ****** ****** *)
//
extern
fun
emit_tmpdeclst_initize
(
  out: FILEref, tds: tmpdeclst
) : void // end-of-fun
//
implement
emit_tmpdeclst_initize
  (out, tds) = let
//
fun auxlst
(
  out: FILEref, tds: tmpdeclst
) : void = let
in
//
case+ tds of
| list_nil () => ()
| list_cons (td, tds) =>
  (
    case+ td.tmpdec_node of
    | TMPDECnone
        (tmp) => auxlst (out, tds)
    | TMPDECsome
        (tmp, _) => let
        val () = emit_nspc (out, 2(*ind*))
        val () =
        (
          emit_text (out, "var "); emit_tmpvar (out, tmp); emit_ENDL (out)
        ) (* end of [val] *)
      in
        auxlst (out, tds)
      end // end of [TMPDECsome]
  ) (* end of [list_cons] *)
//
end // end of [auxlst]
//
in
  auxlst (out, tds)
end // end of [emit_tmpdeclst_initize]
//
(* ****** ****** *)
//
extern
fun
the_tmpdeclst_get (): tmpdeclst
extern
fun
the_tmpdeclst_set (tds: tmpdeclst): void
//
(* ****** ****** *)
//
extern
fun
the_funbodylst_get (): instrlst
extern
fun
the_funbodylst_set (inss: instrlst): void
//
(* ****** ****** *)
//
extern
fun
the_branchlablst_get (): labelist
extern
fun
the_branchlablst_set (tls: labelist): void
extern
fun
the_branchlablst_unset ((*void*)): void
//
(* ****** ****** *)

local
//
val the_tmpdeclst = ref<tmpdeclst> (list_nil)
//
val the_funbodylst = ref<instrlst> (list_nil)
//
// HX: this is a stack:
//
val the_branchlablstlst = ref<List0(labelist)> (list_nil)
//
in (* in-of-local *)

implement
the_tmpdeclst_get () = !the_tmpdeclst
implement
the_tmpdeclst_set (xs) = !the_tmpdeclst := xs

implement
the_funbodylst_get () = !the_funbodylst
implement
the_funbodylst_set (xs) = !the_funbodylst := xs

implement
the_branchlablst_get
(
) = let
//
val xss = !the_branchlablstlst
//
in
//
case- xss of list_cons (xs, _) => xs
//
end // end of [the_branchlablst_get]

implement
the_branchlablst_set
(
  xs
) = let
//
val xss = !the_branchlablstlst
//
in
  !the_branchlablstlst := list_cons (xs, xss)
end // end of [the_branchlablst_set]

implement
the_branchlablst_unset
(
) = let
//
val xss = !the_branchlablstlst
//
in
//
case- xss of
| list_cons (_, xss) => !the_branchlablstlst := xss
//
end // end of [the_branchlablst_unset]

end // end of [local]

(* ****** ****** *)
//
extern
fun
funlab_get_index (fl: label): int
extern
fun
tmplab_get_index (lab: label): int
//
(* ****** ****** *)

implement
funlab_get_index
  (fl0) = let
//
val n0 = fl0.i0de_sym
//
fun
auxlst
(
  xs: instrlst, i: int
) : int = (
//
case+ xs of
| list_nil () => ~1(*error*)
| list_cons (x, xs) =>
  (
    case+ x.instr_node of
    | ATSfunbodyseq _ => let
        val fl = funbodyseq_get_funlab (x)
      in
        if n0 = fl.i0de_sym then i else auxlst (xs, i+1)
      end // end of [ATSfunbodyseq]
    | _ (*non-ATSfunbody*) => auxlst (xs, i)
  ) (* end of [list_cons] *)
//
) (* end of [auxlst] *)
//
in
  auxlst (the_funbodylst_get(), 1)
end // end of [funlab_get_index]

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

implement
tmplab_get_index
  (lab0) = let
//
val n0 = lab0.i0de_sym
//
fun
auxlst
(
  xs: labelist, i: int
) : int =
(
case+ xs of
| list_nil () => ~1(*error*)
| list_cons (x, xs) =>
    if n0 = x.i0de_sym then i else auxlst (xs, i+1)
  // end of [list_cons]
)
//
in
  auxlst (the_branchlablst_get(), 1)
end // end of [tmplab_get_index]

(* ****** ****** *)
//
fun
emit_funlab_index
 (out: FILEref, fl: label): void =
 emit_int (out, funlab_get_index (fl))
//
fun
emit_tmplab_index
 (out: FILEref, lab: label): void =
 emit_int (out, tmplab_get_index (lab))
//
(* ****** ****** *)
//
extern
fun emit2_instr
  (out: FILEref, ind: int, ins: instr) : void
//
extern
fun emit2_instr_ln
  (out: FILEref, ind: int, ins: instr) : void
//
extern
fun emit2_instrlst
  (out: FILEref, ind: int, inss: instrlst) : void
//
(* ****** ****** *)
//
extern
fun emit2_branchseqlst
  (out: FILEref, ind: int, inss: instrlst): void
//
(* ****** ****** *)
//
extern
fun emit2_ATSfunbodyseq
  (out: FILEref, ind: int, ins: instr) : void
//
extern
fun emit2_ATSINSmove_con1
  (out: FILEref, ind: int, ins: instr) : void
extern
fun emit2_ATSINSmove_boxrec
  (out: FILEref, ind: int, ins: instr) : void
//
(* ****** ****** *)
//
// HX-2014-08:
// this one should not be used for
// emitting multiple-line instructions
//
implement
emit_instr
  (out, ins) = emit2_instr (out, 0(*ind*), ins)
//
(* ****** ****** *)

implement
emit2_instr
  (out, ind, ins0) = let
in
//
case+
ins0.instr_node of
//
| ATSif
  (
    d0e, inss, inssopt
  ) => let
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "if")
    val () = emit_LPAREN (out)
    val () = emit_d0exp (out, d0e)
    val () = emit_RPAREN (out)
    val () = emit_text (out, " {\n")
    val () = emit2_instrlst (out, ind+2, inss)
  in
    case+ inssopt of
    | None _ =>
      {
        val () = emit_nspc (out, ind)
        val () = emit_text (out, "} // endif")
      } (* end of [None] *)
    | Some (inss) =>
      {
        val () = emit_nspc (out, ind)
        val () = emit_text (out, "} else {\n")
        val () = emit2_instrlst (out, ind+2, inss)
        val () = emit_nspc (out, ind)
        val ((*closing*)) = emit_text (out, "} // endif")
      } (* end of [Some] *)
  end // end of [ATSif]
//
| ATSifthen (d0e, inss) =>
  {
//
    val-list_cons (ins, _) = inss
//
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "if(")
    val () = emit_d0exp (out, d0e)
    val () = emit_text (out, ") ")
    val () = emit_instr (out, ins)
  }
//
| ATSifnthen (d0e, inss) =>
  {
//
    val-list_cons (ins, _) = inss
//
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "if(!")
    val () = emit_d0exp (out, d0e)
    val ((*closing*)) = emit_text (out, ") ")
    val () = emit_instr (out, ins)
  }
//
| ATSbranchseq (inss) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATSbranchseq(...)")
  }
//
| ATScaseofseq (inss) =>
  {
//
    val tls =
      caseofseq_get_tmplablst (ins0)
    // end of [val]
    val () = the_branchlablst_set (tls)
//
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATScaseofseq_beg")
    val () = emit_ENDL (out)
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "tmplab_js = 1;")
    val () = emit_ENDL (out)
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "while(true) {")
    val () = emit_ENDL (out)
    val () = emit_nspc (out, ind+2)
    val () = emit_text (out, "tmplab = tmplab_js; tmplab_js = 0;")
    val () = emit_ENDL (out)
    val () = emit_nspc (out, ind+2)
    val () = emit_text (out, "switch(tmplab)")
    val () = emit_ENDL (out)
    val () = emit_nspc (out, ind+2)
    val () = emit_text (out, "{")
//
    val () = emit2_branchseqlst (out, ind+4, inss)
//
    val () = emit_nspc (out, ind+2)
    val () = emit_text (out, "} // end-of-switch")
//
    val () = emit_ENDL (out)
    val () = emit_nspc (out, ind+2)
    val () =
      emit_text (out, "if (tmplab_js === 0) break;")
    // end of [val]
//
    val () = emit_ENDL (out)
    val () = emit_nspc (out, ind)
    val ((*closing*)) = emit_text (out, "} // endwhile")
//
    val () = emit_ENDL (out)
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATScaseofseq_end")
//
    val () = the_branchlablst_unset ((*void*))
//
  } (* end of [ATScaseofseq] *)
//
| ATSreturn (tmp) =>
  {
    val () = emit_nspc (out, ind)
    val () =
      emit_text (out, "return ")
    val () = emit_tmpvar (out, tmp)
    val () = emit_SEMICOLON (out)
  }
| ATSreturn_void (tmp) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "return/*_void*/")
    val () = emit_SEMICOLON (out)
  }
//
| ATSINSlab (lab) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "case ")
    val () =
    (
      emit_tmplab_index (out, lab); emit_COLON (out)
    ) (* end of [val] *)
    val () =
    (
      emit_text (out, " // "); emit_label (out, lab)
    ) (* end of [val] *)
  } (* end of [ATSINSlab] *)
//
| ATSINSgoto (lab) =>
  {
    val () = emit_nspc (out, ind)
    val () =
      emit_text (out, "{ tmplab_js = ")
    // end of [val]
    val () = emit_tmplab_index (out, lab)
    val ((*closing*)) = emit_text (out, "; break; }")
  } (* end of [ATSINSgoto] *)
//
| ATSINSflab (flab) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ")
    val () = emit_label (out, flab)
  } (* end of [ATSINSflab] *)
//
| ATSINSfgoto (flab) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "funlab_js = ")
    val () = emit_funlab_index (out, flab)
    val () = (
      emit_text (out, "; // "); emit_label (out, flab)
    ) (* end of [val] *)
  } (* end of [ATSINSfgoto] *)
//
| ATSINSmove (tmp, d0e) =>
  {
    val () = emit_nspc (out, ind)
    val () = (
      emit_tmpvar (out, tmp);
      emit_text (out, " = "); emit_d0exp (out, d0e)
    ) (* end of [val] *)
    val () = emit_SEMICOLON (out)
  } (* end of [ATSINSmove] *)
//
| ATSINSmove_void
    (tmp, d0e(*command*)) => let
    val () = emit_nspc (out, ind)
  in
    case+ d0e.d0exp_node of
    | ATSempty _ =>
        emit_text (out, "// ATSINSmove_void")
      // end of [ATSempty]
    | _ (*non-ATSempty*) =>
        (emit_d0exp (out, d0e); emit_SEMICOLON (out))
  end (* end of [ATSINSmove_void] *)
//
| ATSINSmove_nil (tmp) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_tmpvar (out, tmp)
    val () = emit_text (out, " = ")
    val () = emit_text (out, "null")
    val () = emit_SEMICOLON (out)
  }
| ATSINSmove_con0 (tmp, tag) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_tmpvar (out, tmp)
    val () = emit_text (out, " = ")
    val () = emit_PMVint (out, tag)
    val () = emit_SEMICOLON (out)
  }
//
| ATSINSmove_con1 _ =>
    emit2_ATSINSmove_con1 (out, ind, ins0)
| ATSINSmove_boxrec _ =>
    emit2_ATSINSmove_boxrec (out, ind, ins0)
//
| ATStailcalseq (inss) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATStailcalseq_beg")
    val () = emit_ENDL (out)
    val () = emit2_instrlst (out, ind, inss)
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATStailcalseq_end")

  } (* end of [ATStailcalseq] *)
//
| ATSINSmove_tlcal (tmp, d0e) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_tmpvar (out, tmp)
    val () = emit_text (out, " = ")
    val () = emit_d0exp (out, d0e)
    val () = emit_SEMICOLON (out)
  } (* end of [ATSINSmove_tlcal] *)
//
| ATSINSargmove_tlcal (tmp1, tmp2) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_tmpvar (out, tmp1)
    val () = emit_text (out, " = ")
    val () = emit_tmpvar (out, tmp2)
    val () = emit_SEMICOLON (out)
  } (* end of [ATSINSargmove_tlcal] *)
//
| ATSdynload (dummy) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATSdynload()")
  }
//
| ATSdynload0 (flag) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "var\n")
    val () = (
      emit_tmpvar (out, flag); emit_text (out, " = 0 ;")
    ) (* end of [val] *)
  }
| ATSdynload1 (flag) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATSdynload1(...)")
  }
//
| ATSdynloadset (flag) =>
  {
    val () = emit_nspc (out, ind)
    val () = (
      emit_tmpvar (out, flag); emit_text (out, " = 1 ; // flag is set")
    ) (* end of [val] *)
  }
//
| _ (*rest-of-instr*) =>
  {
    val () = emit_nspc (out, ind)
    val ((*error*)) = fprint! (out, "UNRECOGNIZED-INSTRUCTION: ", ins0)
  }
//
end // end of [emit2_instr]

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

implement
emit2_instr_ln
  (out, ind, ins) =
(
  emit2_instr (out, ind, ins); emit_ENDL (out)
) (* end of [emit2_instr_ln] *)

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

implement
emit2_instrlst
(
  out, ind, inss
) = (
//
case+ inss of
| list_nil () => ()
| list_cons (ins, inss) =>
  {
    val () = emit2_instr_ln (out, ind, ins)
    val () = emit2_instrlst (out, ind, inss)
  }
//
) (* end of [emit2_instrlst] *)

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

implement
emit2_branchseqlst
  (out, ind, inss) = let
//
fun auxseq
(
  out: FILEref
, ind: int, ins0: instr
) : void = let
in
//
case-
ins0.instr_node of
//
| ATSbranchseq
    (inss) => emit2_instrlst (out, ind, inss)
  // end of [ATSbranchseq]
//
end (* end of [auxseq] *)
//
fun auxseqlst
(
  out: FILEref
, ind: int, inss: instrlst
) : void = let
in
//
case+ inss of
| list_nil () => ()
| list_cons
    (ins, inss) => let
//
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATSbranchseq_beg\n")
//
    val () = auxseq (out, ind, ins)
//
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "break;\n")
//
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATSbranchseq_end\n")
//
  in
    auxseqlst (out, ind, inss)
  end (* end of [list_cons] *)
//
end (* end of [auxseqlst] *)
//
in
  auxseqlst (out, ind, inss)
end // end of [emit2_branchseqlst]

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

implement
emit2_ATSfunbodyseq
  (out, ind, ins) = let
//
val-ATSfunbodyseq (inss) = ins.instr_node
//
in
  emit2_instrlst (out, ind, inss)
end // end of [emit2_ATS2funbodyseq]

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

implement
emit2_ATSINSmove_con1
  (out, ind, ins0) = let
//
fun
getarglst
(
  inss: instrlst
) : d0explst =
(
case+ inss of
| list_nil () => list_nil ()
| list_cons (ins, inss) => let
    val-ATSINSstore_con1_ofs (_, _, _, d0e) = ins.instr_node
    val d0es = getarglst (inss)
  in
    list_cons (d0e, d0es)
  end // end of [list_cons]
)
//
val-ATSINSmove_con1 (inss) = ins0.instr_node
//
val-list_cons (ins, inss) = inss
val-ATSINSmove_con1_new (tmp, _) = ins.instr_node
//
var opt: tokenopt = None()
//
val inss =
(
case+ inss of
| list_nil () => inss
| list_cons (ins, inss2) =>
  (
    case+ ins.instr_node of
    | ATSINSstore_con1_tag
        (tmp, tag) => let
        val () = opt := Some(tag) in inss2
      end // end of [ATSINSstore_con1_tag]
    | _ (*non-ATSINSstore_con1_tag*) => inss
  )
) : instrlst
//
val d0es = getarglst (inss)
val () = emit_nspc (out, ind)
val () = emit_tmpvar (out, tmp)
val () = emit_text (out, " = ")
val () = emit_LBRACKET (out)
val () =
(
case+ opt of
| None () => ()
| Some (tag) => emit_PMVint (out, tag)
) : void // end of [val]
val () =
(
case+ opt of
| None _ => emit_d0explst (out, d0es)
| Some _ => emit_d0explst_1 (out, d0es)
) : void // end of [val]
//
val () = emit_RBRACKET (out)
//
val () = emit_SEMICOLON (out)
//
in
  // nothing
end // end of [emit2_ATSINSmove_con1]

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

implement
emit2_ATSINSmove_boxrec
  (out, ind, ins0) = let
//
fun
getarglst
(
  inss: instrlst
) : d0explst =
(
case+ inss of
| list_nil () => list_nil ()
| list_cons (ins, inss) => let
    val-ATSINSstore_boxrec_ofs (_, _, _, d0e) = ins.instr_node
    val d0es = getarglst (inss)
  in
    list_cons (d0e, d0es)
  end // end of [list_cons]
)
//
val-ATSINSmove_boxrec (inss) = ins0.instr_node
//
val-list_cons (ins, inss) = inss
val-ATSINSmove_boxrec_new (tmp, _) = ins.instr_node
//
val d0es = getarglst (inss)
//
val () = emit_nspc (out, ind)
val () = emit_tmpvar (out, tmp)
val () = emit_text (out, " = ")
val () = emit_LBRACKET (out)
val () = emit_d0explst (out, d0es)
val () = emit_RBRACKET (out)
//
val () = emit_SEMICOLON (out)
//
in
  // nothing
end // end of [emit2_ATSINSmove_boxrec]

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

#define
ATSEXTCODE_BEG "/* ATSextcode_beg() */"
#define
ATSEXTCODE_END "/* ATSextcode_end() */"

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

implement
emit_d0ecl
  (out, d0c) = let
in
//
case+
d0c.d0ecl_node of
//
| D0Cinclude _ => ()
//
| D0Cifdef _ => ()
| D0Cifndef _ => ()
//
| D0Ctypedef (id, def) =>
    typedef_insert (id.i0de_sym, def)
  // end of [D0Ctypedef]
//
| D0Cdyncst_mac _ => ()
| D0Cdyncst_extfun _ => ()
//
| D0Cextcode (toks) =>
  {
    val () = emit_ENDL (out)
    val () =
      emit_text (out, ATSEXTCODE_BEG)
    val () = emit_extcode (out, toks) // HX: verbatim output
    val () =
      emit_text (out, ATSEXTCODE_END)
    val ((*void*)) = emit_newline (out)
  } (* end of [D0Cextcode] *)
//
| D0Cstatmp
    (tmp, opt) =>
  {
    val () = emit_ENDL (out)
    val () = (
      case+ opt of
      | Some _ => () | None () => emit_text(out, "/*\n")
    ) (* end of [val] *)
    val () = (
      emit_text (out, "var "); emit_tmpvar (out, tmp); emit_ENDL (out)
    ) (* end of [val] *)
    val () = (
      case+ opt of
      | Some _ => () | None () => emit_text(out, "*/\n")
    ) (* end of [val] *)
  } (* end of [D0Cstatmp] *)
//
| D0Cfundecl (fk, f0d) => emit_f0decl (out, f0d)
//
| D0Cclosurerize
    (fl, env, arg, res) =>
  {
    val () = emit_closurerize (out, fl, env, arg, res)
  }
//
end // end of [emit_d0ecl]

(* ****** ****** *)
//
extern
fun emit_f0arg : emit_type (f0arg)
extern
fun emit_f0marg : emit_type (f0marg)
extern
fun emit_f0head : emit_type (f0head)
//
extern
fun emit_f0body : emit_type (f0body)
extern
fun emit_f0body_0 : emit_type (f0body)
extern
fun emit_f0body_tlcal : emit_type (f0body)
extern
fun emit_f0body_tlcal2 : emit_type (f0body)
//
(* ****** ****** *)

implement
emit_f0arg
  (out, f0a) = let
in
//
case+
f0a.f0arg_node of
//
| F0ARGnone _ => emit_text (out, "__NONE__")
| F0ARGsome (arg, s0e) => emit_tmpvar (out, arg)
//
end // end of [emit_f0arg]

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

implement
emit_f0marg
  (out, f0ma) = let
//
fun
loop
(
  out: FILEref, f0as: f0arglst, i: int
) : void =
(
case+ f0as of
| list_nil () => ()
| list_cons (f0a, f0as) => let
    val () =
      if i > 0 then emit_text (out, ", ")
    // end of [val]
  in
    emit_f0arg (out, f0a); loop (out, f0as, i+1)
  end // end of [list_cons]
)
//
in
  loop (out, f0ma.f0marg_node, 0)
end // end of [emit_f0marg]

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

implement
emit_f0head
  (out, fhd) = let
//
val f0as =
  f0head_get_f0arglst (fhd)
//
in
//
case+
fhd.f0head_node of
| F0HEAD
    (fid, f0ma, res) =>
  {
//
    val () = emit_i0de (out, fid)
//
    val () = emit_LPAREN (out)
    val () = emit_f0marg (out, f0ma)
    val () = emit_RPAREN (out)
//
  }
//
end // end of [emit_f0head]

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

implement
emit_f0body
  (out, fbody) = let
//
val knd = f0body_classify (fbody)
(*
val () =
println! ("emit_f0body: knd = ", knd)
*)
//
val tmpdecs =
  f0body_get_tmpdeclst (fbody)
val inss_body =
  f0body_get_bdinstrlst (fbody)
//
val () = the_tmpdeclst_set (tmpdecs)
val () = the_funbodylst_set (inss_body)
//
val () = emit_text (out, "{\n")
//
val () = emit_text (out, "//\n")
val () = emit_text (out, "// knd = ")
val () = (emit_int (out, knd); emit_ENDL (out))
//
val () =
  emit_tmpdeclst_initize (out, tmpdecs)
//
val () =
if knd > 0 then
{
//
val () = emit_nspc (out, 2)
val () = emit_text (out, "var funlab_js\n")
//
val () = emit_nspc (out, 2)
val () = emit_text (out, "var tmplab, tmplab_js\n")
//
} (* end of [if] *) // end of [val]
//
val () = emit_text (out, "//\n")
//
val () = (
//
case+ knd of
| 1 => emit_f0body_tlcal (out, fbody)
| 2 => emit_f0body_tlcal2 (out, fbody)
| _ (*0*) => emit_f0body_0 (out, fbody)
//
) : void // end of [val]
//
val () = emit_text (out, "} // end-of-function\n")
//
in
  // nothing
end (* end of [emit_f0body] *)

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

implement
emit_f0body_0
  (out, fbody) = let
//
fun
auxlst
(
  out: FILEref, inss: instrlst, i: int
) : void =
(
case+ inss of
| list_nil () => ()
| list_cons
    (ins0, inss1) => let
    val-list_cons (ins1, inss2) = inss1
//
    val () = if i > 0 then emit_ENDL (out)
    val () = emit2_ATSfunbodyseq (out, 2(*ind*), ins0)
    val ((*return*)) = emit2_instr_ln (out, 2(*ind*), ins1)
//
  in
    auxlst (out, inss2, i+1)
  end // end of [list_cons]
//
) (* end of [auxlst] *)
//
in
//
case+
fbody.f0body_node of
//
| F0BODY (tds, inss) =>
  {
    val () = auxlst (out, inss, 0(*i*))
  }
//
end // end of [emit_f0body_0]

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

implement
emit_f0body_tlcal
  (out, fbody) = let
//
fun
auxlst
(
  out: FILEref, inss: instrlst
) : void =
(
case+ inss of
| list_nil () => ()
| list_cons
    (ins0, inss1) => let
    val-list_cons (ins1, inss2) = inss1
//
    val () =
    emit2_ATSfunbodyseq (out, 4(*ind*), ins0)
//
    val () = emit_nspc (out, 4(*ind*))
    val () =
    emit_text
    (
      out, "if (funlab_js > 0) continue; else"
    ) (* end of [val] *)
    val () = emit2_instr_ln (out, 1(*ind*), ins1)
//
    val () = emit_nspc (out, 2(*ind*))
    val () = emit_text (out, "} // endwhile-fun\n")
//
  in
    auxlst (out, inss2(*nil*))
  end // end of [list_cons]
//
) (* end of [auxlst] *)
//
val () = emit_nspc (out, 2(*ind*))
val () = emit_text (out, "while(true) {\n")
val () = emit_nspc (out, 4(*ind*))
val () = emit_text (out, "funlab_js = 0;\n")
//
val () =
(
case+
fbody.f0body_node of
//
| F0BODY (tds, inss) => auxlst (out, inss)
//
) (* end of [val] *)
//
in
  // nothing
end // end of [emit_f0body_tlcal]

(* ****** ****** *)
//
extern
fun
emit_the_funbodylst (out: FILEref): void
//
implement
emit_the_funbodylst
  (out) = let
//
fun auxfun
(
  out: FILEref
, ins0: instr, ins1: instr, i: int
) : void = let
//
val-ATSfunbodyseq(inss) = ins0.instr_node
//
val-list_cons (ins_fl, inss) = inss
val-ATSINSflab (fl) = ins_fl.instr_node
//
val () = emit_ENDL (out)
val () = emit_nspc (out, 6)
val () =
(
  emit_text (out, "case ");
  emit_int (out, i); emit_text (out, ": {")
)
val () = emit_ENDL (out)
val () = emit_nspc (out, 8)
val () = emit_text (out, "funlab_js = 0;\n")
val () = emit2_instrlst (out, 8(*ind*), inss)
//
val () = emit_nspc (out, 8)
val () =
emit_text
(
  out, "if (funlab_js > 0) continue; else"
) (* end of [val] *)
val () = emit2_instr_ln (out, 1(*ind*), ins1)
//
val () = emit_nspc (out, 6)
val () = emit_text (out, "} // end-of-case")
//
in
  // nothing
end // end of [auxfun]
//
fun auxlst
(
  out: FILEref, inss: instrlst, i: int
) : void =
(
case+ inss of
| list_nil () => ()
| list_cons _ => let
    val-list_cons (ins0, inss) = inss
    val-list_cons (ins1, inss) = inss
    val () = auxfun (out, ins0, ins1, i)
  in
    auxlst (out, inss, i+1)
  end // end of [auxlst]
) (* end of [auxlst] *)
//
in
  auxlst (out, the_funbodylst_get((*void*)), 1(*i*))
end // end of [emit_the_funbodylst]
//
(* ****** ****** *)

implement
emit_f0body_tlcal2
  (out, fbody) = let
//
val () = emit_nspc (out, 2(*ind*))
val () = emit_text (out, "funlab_js = 1;")
//
val () = emit_ENDL (out)
val () = emit_nspc (out, 2(*ind*))
val () = emit_text (out, "while(true) {")
//
val () = emit_ENDL (out)
val () = emit_nspc (out, 4(*ind*))
val () = emit_text (out, "switch(funlab_js) {")
//
val () = emit_the_funbodylst (out)
//
val () = emit_nspc (out, 4(*ind*))
val ((*closing*)) = emit_text (out, "} // end-of-switch\n")
//
val () = emit_nspc (out, 2(*ind*))
val ((*closing*)) = emit_text (out, "} // endwhile-fun\n")
//
in
  // nothing
end // end of [emit_f0body_tlcal2]

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

implement
emit_f0decl
  (out, fdec) = let
in
//
case+
fdec.f0decl_node of
| F0DECLnone (fhd) => ()
| F0DECLsome (fhd, fbody) =>
  {
    val () = emit_ENDL (out)
    val () = emit_text (out, "function")
    val () = emit_ENDL (out)
    val () = emit_f0head (out, fhd)
    val () = emit_ENDL (out)
    val () = emit_f0body (out, fbody)
    val () = emit_newline (out)
  } (* end of [F0DECLsome] *)
//
end // end of [emit_f0decl]

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

implement
emit_toplevel
  (out, d0cs) = let
//
fun
loop
(
  out: FILEref, d0cs: d0eclist
) : void =
(
//
case+ d0cs of
| list_nil () => ()
| list_cons
    (d0c, d0cs) => let
    val () =
      emit_d0ecl (out, d0c)
    // end of [val]
  in
    loop (out, d0cs)
  end // end of [list_cons]
//
)
//
in
  loop (out, d0cs)
end // end of [emit_toplevel]

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

(* end of [atsparemit_emit2_js.dats] *)


Updating: merging

Updating: merging

(*
** libatscc-common
*)

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

(*
staload "./../../basics.sats"
*)

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

#define nil0 list0_nil
#define cons0 list0_cons
#define sing0(x) list0_cons(x, list0_nil)

(* ****** ****** *)
//
fun{}
list0_sing{a:t0p}(x: a): list0(a)
//
(* ****** ****** *)
//
fun{}
list0_is_nil
  {a:t0p}(xs: list0(INV(a))): bool
//
fun{}
list0_is_cons
  {a:t0p}(xs: list0(INV(a))): bool
//
(* ****** ****** *)

overload iseqz with list0_is_nil
overload isneqz with list0_is_cons

(* ****** ****** *)
//
fun
list0_head_opt
  {a:t0p}
  (list0(INV(a))): Option_vt(a) = "mac#%"
//
overload .head_opt with list0_head_opt
//
(* ****** ****** *)
//
fun
list0_tail_opt
  {a:t0p}
  (list0(INV(a))): Option_vt(list0(a)) = "mac#%"
//
overload .tail_opt with list0_tail_opt
//
(* ****** ****** *)
//
fun
list0_length
  {a:t0p}(list0(a)): intGte(0) = "mac#%"
//
overload length with list0_length of 100
//
(* ****** ****** *)
//
fun
list0_last_opt
  {a:t0p}
  (xs: list0(INV(a))): Option(a) = "mac#%"
//
(* ****** ****** *)
//
fun
list0_get_at_opt
  {a:t0p}
  (list0(INV(a)), intGte(0)): Option(a) = "mac#%"
//
(* ****** ****** *)
//
fun
list0_make_intrange_2
  (l: int, r: int): list0(int) = "mac#%"
fun
list0_make_intrange_3
  (l: int, r: int, d: int): list0(int) = "mac#%"
//
symintr list0_make_intrange
//
overload
list0_make_intrange with list0_make_intrange_2
overload
list0_make_intrange with list0_make_intrange_3
//
(* ****** ****** *)
//
fun
{a:t0p}
print_list0
  (xs: list0(INV(a))): void = "mac#%"
fun
{a:t0p}
print_list0_sep
  (xs: list0(INV(a)), sep: string): void = "mac#%"
//
overload
print with print_list0 of 100
//
(* ****** ****** *)
//
fun
list0_snoc
  {a:t0p}
  (list0(INV(a)), x0: a): list0(a)= "mac#%"
//
fun
list0_extend
  {a:t0p}
  (list0(INV(a)), x0: a): list0(a)= "mac#%"
//
(* ****** ****** *)
//
fun
list0_append
  {a:t0p}
(
  xs: list0(INV(a)), ys: list0(a)
) : list0(a) = "mac#%" // end-of-fun
//
overload + with list0_append of 100 // infix
//
(* ****** ****** *)
//
fun
list0_reverse
  {a:t0p}
  (xs: list0(INV(a))): list0(a) = "mac#%"
fun
list0_reverse_append
  {a:t0p}
  (xs: list0(INV(a)), ys: list0(a)): list0(a) = "mac#%"
//
overload reverse with list0_reverse of 100
overload revappend with list0_reverse_append of 100
//
(* ****** ****** *)
//
fun
list0_concat
  {a:t0p}(xs: list0(list0(a))): list0(a) = "mac#%"
//
(* ****** ****** *)
//
fun
list0_remove_at_opt
  {a:t0p}
  (list0(INV(a)), i: intGte(0)): Option(list0(a)) = "mac#%"
//
(* ****** ****** *)
//
fun
list0_exists
  {a:t0p}
  (list0(INV(a)), pred: cfun(a, bool)): bool = "mac#%"
fun
list0_exists_method
  {a:t0p}
  (list0(INV(a)))(pred: cfun(a, bool)): bool = "mac#%"
//
overload .exists with list0_exists_method
//
fun
list0_iexists
  {a:t0p}
(
  xs: list0(INV(a)), pred: cfun(intGte(0), a, bool)
) : bool = "mac#%" // end of [list0_iexists]
fun
list0_iexists_method
  {a:t0p}
(
  xs: list0(INV(a)))(pred: cfun(intGte(0), a, bool)
) : bool = "mac#%" // end of [list0_iexists]
//
overload .iexists with list0_iexists_method
//
(* ****** ****** *)
//
fun
list0_forall
  {a:t0p}
  (list0(INV(a)), pred: cfun(a, bool)): bool = "mac#%"
fun
list0_forall_method
  {a:t0p}
  (list0(INV(a)))(pred: cfun(a, bool)): bool = "mac#%"
//
overload .forall with list0_forall_method
//
fun
list0_iforall
  {a:t0p}
(
  xs: list0(INV(a)), pred: cfun(intGte(0), a, bool)
) : bool = "mac#%" // end of [list0_iforall]
fun
list0_iforall_method
  {a:t0p}
(
  xs: list0(INV(a)))(pred: cfun(intGte(0), a, bool)
) : bool = "mac#%" // end of [list0_iforall]
//
overload .iforall with list0_iforall_method
//
(* ****** ****** *)
//
fun
list0_app
  {a:t0p}
(
  xs: list0(INV(a)), fwork: cfun(a, void)
) : void = "mac#%" // end-of-function
fun
list0_foreach
  {a:t0p}
(
  xs: list0(INV(a)), fwork: cfun(a, void)
) : void = "mac#%" // end-of-function
fun
list0_foreach_method
  {a:t0p}
(
  xs: list0(INV(a)))(fwork: cfun(a, void)
) : void = "mac#%" // end-of-function
//
overload .foreach with list0_foreach_method
//
(* ****** ****** *)
//
fun
list0_iforeach
  {a:t0p}
(
  xs: list0(INV(a)), fwork: cfun(int, a, void)
) : void = "mac#%" // end-of-function
fun
list0_iforeach_method
  {a:t0p}
(
  xs: list0(INV(a)))(fwork: cfun(int, a, void)
) : void = "mac#%" // end-of-function
//
overload .iforeach with list0_iforeach_method
//
(* ****** ****** *)
//
fun
list0_rforeach
  {a:t0p}
  (xs: list0(INV(a)), fwork: cfun(a, void)): void = "mac#%"
fun
list0_rforeach_method
  {a:t0p}
  (xs: list0(INV(a)))(fwork: cfun(a, void)): void = "mac#%"
//
overload .rforeach with list0_rforeach_method
//
(* ****** ****** *)
//
fun
list0_filter
  {a:t0p}
(
  xs: list0(INV(a)), pred: cfun(a, bool)
) : list0(a) = "mac#%" // end-of-function
fun
list0_filter_method
  {a:t0p}
(
  xs: list0(INV(a)))(pred: cfun(a, bool)
) : list0(a) = "mac#%" // end-of-function
//
overload .filter with list0_filter_method
//
(* ****** ****** *)
//
fun
list0_map
  {a:t0p}{b:t0p}
  (list0(INV(a)), fopr: cfun(a, b)): list0(b) = "mac#%"
fun
list0_map_method
  {a:t0p}{b:t0p}
  (list0(INV(a)), TYPE(b))(fopr: cfun(a, b)): list0(b) = "mac#%"
//
overload .map with list0_map_method
//
(* ****** ****** *)
//
fun
list0_mapcons
  {a:t0p}
  (x0: a, xss: list0(list0(INV(a)))): list0(list0(a)) = "mac#%"
//
(* ****** ****** *)
//
fun
list0_find_opt
  {a:t0p}
(
  xs: list0(INV(a)), pred: cfun(a, bool)
) : Option_vt(a) = "mac#%" // end-of-fun
fun
list0_find_opt_method
  {a:t0p}
(
  xs: list0(INV(a)))(pred: cfun(a, bool)
) : Option_vt(a) = "mac#%" // end-of-fun
//
overload .find_opt with list0_find_opt_method
//
(* ****** ****** *)
//
fun
list0_zip
  {a1,a2:t0p}
(
  xs: list0(INV(a1)), ys: list0(INV(a2))
) :<> list0($tup(a1, a2)) = "mac#%" // end-of-fun
//
fun
list0_zipwith
  {a1,a2:t0p}{b:t0p}
(
  xs: list0(INV(a1)), ys: list0(INV(a2)), fopr: cfun(a1, a2, b)
) :<1> list0(b) = "mac#%" // end of [list0_zipwith]
//
fun
list0_zipwith_method
  {a1,a2:t0p}{b:t0p}
(
  xs: list0(INV(a1)), ys: list0(INV(a2)))(fopr: cfun(a1, a2, b)
) :<1> list0(b) = "mac#%" // end of [list0_zipwith_method]
//
overload .map2 with list0_zipwith_method
overload .zipwith with list0_zipwith_method
//
(* ****** ****** *)

fun
list0_foldleft
  {res:t0p}{a:t0p}
(
  list0(INV(a)), init: res, fopr: cfun(res, a, res)
) : res = "mac#%" // end-of-function
fun
list0_foldright
  {a:t0p}{res:t0p}
(
  list0(INV(a)), fopr: cfun(a, res, res), sink: res
) : res = "mac#%" // end-of-function

(* ****** ****** *)
//
fun
{a:t0p}
list0_sort_1
  (list0(INV(a))): list0(a) = "mac#%"
//
fun
list0_sort_2
  {a:t0p}
(
  list0(INV(a)), cmp: (a, a) -<cloref1> int
) : list0(a) = "mac#%"
//
symintr list0_sort
overload list0_sort with list0_sort_1 of 100
overload list0_sort with list0_sort_2 of 100
//
(* ****** ****** *)
//
fun
streamize_list0_zip
  {a,b:t0p}
(
  xs: list0(INV(a))
, ys: list0(INV(b))
) :<>
  stream_vt($tup(a,b)) = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun
streamize_list0_cross
  {a,b:t0p}
(
  xs: list0(INV(a))
, ys: list0(INV(b))
) :<>
  stream_vt($tup(a,b)) = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun
streamize_list0_nchoose
  {a:t0p}
(
  xs: list0(INV(a)), n: intGte(0)
) :<> stream_vt(list0(a)) = "mac#%" // end-of-fun
fun
streamize_list0_nchoose_rest
  {a:t0p}
(
  xs: list0(INV(a)), n: intGte(0)
) :<> stream_vt($tup(list0(a), list0(a))) = "mac#%"
//
(* ****** ****** *)

(* end of [list0.sats] *)

(*
** libatscc-common
*)

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

(*
staload "./../../basics.sats"
*)

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

#define nil0 list0_nil
#define cons0 list0_cons
#define sing0(x) list0_cons(x, list0_nil)

(* ****** ****** *)
//
fun{}
list0_sing{a:t0p}(x: a): list0(a)
//
(* ****** ****** *)
//
fun{}
list0_is_nil
  {a:t0p}(xs: list0(INV(a))): bool
//
fun{}
list0_is_cons
  {a:t0p}(xs: list0(INV(a))): bool
//
(* ****** ****** *)

overload iseqz with list0_is_nil
overload isneqz with list0_is_cons

(* ****** ****** *)
//
fun
list0_head_opt
  {a:t0p}
  (list0(INV(a))): Option_vt(a) = "mac#%"
//
overload .head_opt with list0_head_opt
//
(* ****** ****** *)
//
fun
list0_tail_opt
  {a:t0p}
  (list0(INV(a))): Option_vt(list0(a)) = "mac#%"
//
overload .tail_opt with list0_tail_opt
//
(* ****** ****** *)
//
fun
list0_length
  {a:t0p}(list0(a)): intGte(0) = "mac#%"
//
overload length with list0_length of 100
//
(* ****** ****** *)
//
fun
list0_last_opt
  {a:t0p}
  (xs: list0(INV(a))): Option(a) = "mac#%"
//
(* ****** ****** *)
//
fun
list0_get_at_opt
  {a:t0p}
  (list0(INV(a)), intGte(0)): Option(a) = "mac#%"
//
(* ****** ****** *)
//
fun
list0_make_intrange_2
  (l: int, r: int): list0(int) = "mac#%"
fun
list0_make_intrange_3
  (l: int, r: int, d: int): list0(int) = "mac#%"
//
symintr list0_make_intrange
//
overload
list0_make_intrange with list0_make_intrange_2
overload
list0_make_intrange with list0_make_intrange_3
//
(* ****** ****** *)
//
fun
{a:t0p}
print_list0
  (xs: list0(INV(a))): void = "mac#%"
fun
{a:t0p}
print_list0_sep
  (xs: list0(INV(a)), sep: string): void = "mac#%"
//
overload
print with print_list0 of 100
//
(* ****** ****** *)
//
fun
list0_snoc
  {a:t0p}
  (list0(INV(a)), x0: a): list0(a)= "mac#%"
//
fun
list0_extend
  {a:t0p}
  (list0(INV(a)), x0: a): list0(a)= "mac#%"
//
(* ****** ****** *)
//
fun
list0_append
  {a:t0p}
(
  xs: list0(INV(a)), ys: list0(a)
) : list0(a) = "mac#%" // end-of-fun
//
overload + with list0_append of 100 // infix
//
(* ****** ****** *)
//
fun
list0_reverse
  {a:t0p}
  (xs: list0(INV(a))): list0(a) = "mac#%"
fun
list0_reverse_append
  {a:t0p}
  (xs: list0(INV(a)), ys: list0(a)): list0(a) = "mac#%"
//
overload reverse with list0_reverse of 100
overload revappend with list0_reverse_append of 100
//
(* ****** ****** *)
//
fun
list0_concat
  {a:t0p}(xs: list0(list0(a))): list0(a) = "mac#%"
//
(* ****** ****** *)
//
fun
list0_remove_at_opt
  {a:t0p}
  (list0(INV(a)), i: intGte(0)): Option(list0(a)) = "mac#%"
//
(* ****** ****** *)
//
fun
list0_exists
  {a:t0p}
  (list0(INV(a)), pred: cfun(a, bool)): bool = "mac#%"
fun
list0_exists_method
  {a:t0p}
  (list0(INV(a)))(pred: cfun(a, bool)): bool = "mac#%"
//
overload .exists with list0_exists_method
//
fun
list0_iexists
  {a:t0p}
(
  xs: list0(INV(a)), pred: cfun(intGte(0), a, bool)
) : bool = "mac#%" // end of [list0_iexists]
fun
list0_iexists_method
  {a:t0p}
(
  xs: list0(INV(a)))(pred: cfun(intGte(0), a, bool)
) : bool = "mac#%" // end of [list0_iexists]
//
overload .iexists with list0_iexists_method
//
(* ****** ****** *)
//
fun
list0_forall
  {a:t0p}
  (list0(INV(a)), pred: cfun(a, bool)): bool = "mac#%"
fun
list0_forall_method
  {a:t0p}
  (list0(INV(a)))(pred: cfun(a, bool)): bool = "mac#%"
//
overload .forall with list0_forall_method
//
fun
list0_iforall
  {a:t0p}
(
  xs: list0(INV(a)), pred: cfun(intGte(0), a, bool)
) : bool = "mac#%" // end of [list0_iforall]
fun
list0_iforall_method
  {a:t0p}
(
  xs: list0(INV(a)))(pred: cfun(intGte(0), a, bool)
) : bool = "mac#%" // end of [list0_iforall]
//
overload .iforall with list0_iforall_method
//
(* ****** ****** *)
//
fun
list0_app
  {a:t0p}
(
  xs: list0(INV(a)), fwork: cfun(a, void)
) : void = "mac#%" // end-of-function
fun
list0_foreach
  {a:t0p}
(
  xs: list0(INV(a)), fwork: cfun(a, void)
) : void = "mac#%" // end-of-function
fun
list0_foreach_method
  {a:t0p}
(
  xs: list0(INV(a)))(fwork: cfun(a, void)
) : void = "mac#%" // end-of-function
//
overload .foreach with list0_foreach_method
//
(* ****** ****** *)
//
fun
list0_iforeach
  {a:t0p}
(
  xs: list0(INV(a)), fwork: cfun(int, a, void)
) : void = "mac#%" // end-of-function
fun
list0_iforeach_method
  {a:t0p}
(
  xs: list0(INV(a)))(fwork: cfun(int, a, void)
) : void = "mac#%" // end-of-function
//
overload .iforeach with list0_iforeach_method
//
(* ****** ****** *)
//
fun
list0_rforeach
  {a:t0p}
  (xs: list0(INV(a)), fwork: cfun(a, void)): void = "mac#%"
fun
list0_rforeach_method
  {a:t0p}
  (xs: list0(INV(a)))(fwork: cfun(a, void)): void = "mac#%"
//
overload .rforeach with list0_rforeach_method
//
(* ****** ****** *)
//
fun
list0_filter
  {a:t0p}
(
  xs: list0(INV(a)), pred: cfun(a, bool)
) : list0(a) = "mac#%" // end-of-function
fun
list0_filter_method
  {a:t0p}
(
  xs: list0(INV(a)))(pred: cfun(a, bool)
) : list0(a) = "mac#%" // end-of-function
//
overload .filter with list0_filter_method
//
(* ****** ****** *)
//
fun
list0_map
  {a:t0p}{b:t0p}
  (list0(INV(a)), fopr: cfun(a, b)): list0(b) = "mac#%"
fun
list0_map_method
  {a:t0p}{b:t0p}
  (list0(INV(a)), TYPE(b))(fopr: cfun(a, b)): list0(b) = "mac#%"
//
overload .map with list0_map_method
//
(* ****** ****** *)
//
fun
list0_mapcons
  {a:t0p}
  (x0: a, xss: list0(list0(INV(a)))): list0(list0(a)) = "mac#%"
//
(* ****** ****** *)
//
fun
list0_zip
  {a1,a2:t0p}
(
  xs: list0(INV(a1)), ys: list0(INV(a2))
) :<> list0($tup(a1, a2)) = "mac#%" // end-of-fun
//
fun
list0_zipwith
  {a1,a2:t0p}{b:t0p}
(
  xs: list0(INV(a1)), ys: list0(INV(a2)), fopr: cfun(a1, a2, b)
) :<1> list0(b) = "mac#%" // end of [list0_zipwith]
//
fun
list0_zipwith_method
  {a1,a2:t0p}{b:t0p}
(
  xs: list0(INV(a1)), ys: list0(INV(a2)))(fopr: cfun(a1, a2, b)
) :<1> list0(b) = "mac#%" // end of [list0_zipwith_method]
//
overload .map2 with list0_zipwith_method
overload .zipwith with list0_zipwith_method
//
(* ****** ****** *)

fun
list0_foldleft
  {res:t0p}{a:t0p}
(
  list0(INV(a)), init: res, fopr: cfun(res, a, res)
) : res = "mac#%" // end-of-function
fun
list0_foldright
  {a:t0p}{res:t0p}
(
  list0(INV(a)), fopr: cfun(a, res, res), sink: res
) : res = "mac#%" // end-of-function

(* ****** ****** *)
//
fun
{a:t0p}
list0_sort_1
  (list0(INV(a))): list0(a) = "mac#%"
//
fun
list0_sort_2
  {a:t0p}
(
  list0(INV(a)), cmp: (a, a) -<cloref1> int
) : list0(a) = "mac#%"
//
symintr list0_sort
overload list0_sort with list0_sort_1 of 100
overload list0_sort with list0_sort_2 of 100
//
(* ****** ****** *)
//
fun
streamize_list0_zip
  {a,b:t0p}
(
  xs: list0(INV(a))
, ys: list0(INV(b))
) :<>
  stream_vt($tup(a,b)) = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun
streamize_list0_cross
  {a,b:t0p}
(
  xs: list0(INV(a))
, ys: list0(INV(b))
) :<>
  stream_vt($tup(a,b)) = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun
streamize_list0_nchoose
  {a:t0p}
(
  xs: list0(INV(a)), n: intGte(0)
) :<> stream_vt(list0(a)) = "mac#%" // end-of-fun
fun
streamize_list0_nchoose_rest
  {a:t0p}
(
  xs: list0(INV(a)), n: intGte(0)
) :<> stream_vt($tup(list0(a), list0(a))) = "mac#%"
//
(* ****** ****** *)

(* end of [list0.sats] *)


Updating: support for handling s2rtdat

Updating: support for handling s2rtdat

(*
** ATS-extsolve:
** For solving ATS-constraints
** with external SMT-solvers
*)

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

(*
** Author: Hongwei Xi
** Authoremail: gmhwxiATgmailDOTcom
*)

(* ****** ****** *)
//
#define ATS_PACKNAME "PATSOLVE_CNSTRNT"
//
(* ****** ****** *)
//
abst0ype
stamp_t0ype = int
//
typedef stamp = stamp_t0ype
//
(* ****** ****** *)
//
fun print_stamp: stamp -> void
and prerr_stamp: stamp -> void
fun fprint_stamp: fprint_type(stamp)
//
overload print with print_stamp
overload prerr with prerr_stamp
overload fprint with fprint_stamp
//
(* ****** ****** *)

fun stamp_make(int): stamp

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

fun stamp_get_int(stamp): int

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

fun hash_stamp(stamp):<> ulint

(* ****** ****** *)
//
fun
eq_stamp_stamp : (stamp, stamp) -<fun0> bool
fun
neq_stamp_stamp : (stamp, stamp) -<fun0> bool
fun
compare_stamp_stamp : (stamp, stamp) -<fun0> int
//
overload = with eq_stamp_stamp
overload != with neq_stamp_stamp
overload compare with compare_stamp_stamp
//
(* ****** ****** *)
//
fun the_stamp_getinc(): stamp
//
fun the_stamp_update(n: stamp): void
//
(* ****** ****** *)

abstype symbol_type = ptr
typedef symbol = symbol_type

(* ****** ****** *)
//
fun print_symbol: symbol -> void
and prerr_symbol: symbol -> void
fun fprint_symbol: fprint_type(symbol)
//
overload print with print_symbol
overload prerr with prerr_symbol
overload fprint with fprint_symbol
//
(* ****** ****** *)

fun
symbol_make_name (string): symbol

(* ****** ****** *)
//
fun
symbol_get_name (symbol): string
//
overload .name with symbol_get_name
//
(* ****** ****** *)
//
fun
eq_symbol_symbol : (symbol, symbol) -<fun0> bool
fun
neq_symbol_symbol : (symbol, symbol) -<fun0> bool
fun
compare_symbol_symbol : (symbol, symbol) -<fun0> int
//
overload = with eq_symbol_symbol
overload != with neq_symbol_symbol
overload compare with compare_symbol_symbol
//
(* ****** ****** *)
//
abstype
location_type = ptr
//
typedef loc_t = location_type
//
(* ****** ****** *)
//
fun
fprint_location: fprint_type(loc_t)
//
overload fprint with fprint_location
//
(* ****** ****** *)
//
fun location_make (rep: string): loc_t
//
(* ****** ****** *)
//
datatype label =
  LABint of int | LABsym of symbol
//
(* ****** ****** *)
//
fun print_label : label -> void
and prerr_label : label -> void
fun fprint_label : fprint_type(label)
//
overload print with print_label
overload prerr with prerr_label
overload fprint with fprint_label
//
(* ****** ****** *)

datatype s2rt =
//
  | S2RTint of ()
  | S2RTaddr of ()
  | S2RTbool of ()
//
  | S2RTreal of ()
  | S2RTstring of ()
//
  | S2RTcls of ()
  | S2RTeff of ()
//
  | S2RTtup of ((*void*))
//
  | S2RTtype of ((*void*))
  | S2RTvtype of ((*void*))
//
  | S2RTt0ype of ((*void*))
  | S2RTvt0ype of ((*void*))
//
  | S2RTprop of ((*void*))
  | S2RTview of ((*void*))
//
  | S2RTtkind of ((*void*))
//
  | S2RTfun of (s2rtlst(*args*), s2rt (*res*))
//
  | S2RTnamed of (symbol)
//
  | S2RTerror of ((*void*))
//
// end of [datatype]

where s2rtlst = List0(s2rt)

(* ****** ****** *)
//
fun s2rt_int((*void*)): s2rt
fun s2rt_addr((*void*)): s2rt
fun s2rt_bool((*void*)): s2rt
//
fun s2rt_real((*void*)): s2rt
fun s2rt_string((*void*)): s2rt
//
(* ****** ****** *)
//
fun
s2rt_is_impred(s2t: s2rt): bool
//
(* ****** ****** *)
//
fun print_s2rt : s2rt -> void
and prerr_s2rt : s2rt -> void
fun fprint_s2rt: fprint_type(s2rt)
//
overload print with print_s2rt
overload prerr with prerr_s2rt
overload fprint with fprint_s2rt
//
(* ****** ****** *)

abstype
s2rtdat_type = ptr
typedef s2rtdat = s2rtdat_type

(* ****** ****** *)
//
fun s2rtdat_get_name (s2rtdat): symbol
fun s2rtdat_get_stamp (s2rtdat): stamp
//
(* ****** ****** *)
//
fun print_s2rtdat : s2rtdat -> void
and prerr_s2rtdat : s2rtdat -> void
fun fprint_s2rtdat: fprint_type(s2rtdat)
//
overload print with print_s2rtdat
overload prerr with prerr_s2rtdat
overload fprint with fprint_s2rtdat
//
(* ****** ****** *)
//
abstype
s2cst_type = ptr
//
typedef s2cst = s2cst_type
//
typedef s2cstlst = List0(s2cst)
vtypedef s2cstlst_vt = List0_vt(s2cst)
//
typedef s2cstopt = Option(s2cst)
vtypedef s2cstopt_vt = Option_vt(s2cst)
//
(* ****** ****** *)
//
fun
s2cst_make
  (symbol, s2rt, stamp): s2cst
//
(* ****** ****** *)
//
fun print_s2cst: s2cst -> void
and prerr_s2cst: s2cst -> void
fun fprint_s2cst: fprint_type(s2cst)
//
overload print with print_s2cst
overload prerr with prerr_s2cst
overload fprint with fprint_s2cst
//
(* ****** ****** *)
//
fun s2cst_get_srt (s2cst): s2rt
fun s2cst_get_name (s2cst): symbol
fun s2cst_get_stamp (s2cst): stamp
//
overload .srt with s2cst_get_srt
overload .name with s2cst_get_name
overload .stamp with s2cst_get_stamp
//
(* ****** ****** *)

fun s2cst_get_payload(s2cst): ptr
fun s2cst_set_payload(s2cst, payload: ptr): void

(* ****** ****** *)
//
abstype
s2var_type = ptr
//
typedef s2var = s2var_type
//
typedef s2varlst = List0(s2var)
vtypedef s2varlst_vt = List0_vt(s2var)
//
typedef s2varopt = Option(s2var)
vtypedef s2varopt_vt = Option_vt(s2var)
//
(* ****** ****** *)
//
fun
s2var_make
  (symbol, s2rt, stamp): s2var
//
(* ****** ****** *)
//
fun print_s2var: s2var -> void
and prerr_s2var: s2var -> void
fun fprint_s2var: fprint_type(s2var)
//
overload print with print_s2var
overload prerr with prerr_s2var
overload fprint with fprint_s2var
//
(* ****** ****** *)
//
fun
s2var_get_srt (s2var): s2rt
fun
s2var_get_name (s2var): symbol
fun
s2var_get_stamp (s2var): stamp
//
overload .srt with s2var_get_srt
overload .name with s2var_get_name
overload .stamp with s2var_get_stamp
//
(* ****** ****** *)

fun s2var_is_impred (s2v: s2var): bool

(* ****** ****** *)
//
fun s2var_get_payload(s2var): ptr
fun s2var_set_payload(s2var, payload: ptr): void
//
(* ****** ****** *)
//
abstype
s2Var_type = ptr
//
typedef s2Var = s2Var_type
//
typedef s2Varlst = List0(s2Var)
vtypedef s2Varlst_vt = List0_vt(s2Var)
//
typedef s2Varopt = Option(s2Var)
vtypedef s2Varopt_vt = Option_vt(s2Var)
//
(* ****** ****** *)
//
fun s2Var_make(stamp): s2Var
//
(* ****** ****** *)
//
fun print_s2Var: s2Var -> void
and prerr_s2Var: s2Var -> void
fun fprint_s2Var: fprint_type(s2Var)
//
overload print with print_s2Var
overload prerr with prerr_s2Var
overload fprint with fprint_s2Var
//
(* ****** ****** *)
//
fun
s2Var_get_stamp (s2Var): stamp
//
overload .stamp with s2Var_get_stamp
//
(* ****** ****** *)

datatype
tyreckind =
  | TYRECKINDbox (* boxed *)
  | TYRECKINDbox_lin (* boxed *)
  | TYRECKINDflt0 (* flat *)
  | TYRECKINDflt1 of stamp (* flat *)
  | TYRECKINDflt_ext of string  (* flat *)
// end of [tyreckind]

(* ****** ****** *)
//
fun tyreckind_is_box (knd: tyreckind): bool
fun tyreckind_is_box_lin (knd: tyreckind): bool
//
fun tyreckind_is_flt0 (knd: tyreckind): bool
fun tyreckind_is_flt1 (knd: tyreckind): bool
fun tyreckind_is_flt_ext (knd: tyreckind): bool
//
(* ****** ****** *)
//
fun
print_tyreckind : tyreckind -> void
and
prerr_tyreckind : tyreckind -> void
fun
fprint_tyreckind : fprint_type(tyreckind)
//
overload print with print_tyreckind
overload prerr with prerr_tyreckind
overload fprint with fprint_tyreckind
//
(* ****** ****** *)
//
datatype
s2exp_node =
//
| S2Eint of (int)
| S2Eintinf of (string)
//
| S2Ecst of (s2cst)
| S2Evar of (s2var)
| S2EVar of (s2Var)
//
| S2Eeqeq of (s2exp, s2exp)
//
| S2Esizeof of (s2exp(*t0ype*))
//
| S2Eapp of (s2exp, s2explst)
| S2Emetdec of
    (s2explst(*met*), s2explst(*bound*)) // strictly decreasing
  // end of [S2Emetdec]
//
| S2Etop of (int(*knd*), s2exp)
//
| S2Einvar of (s2exp)
//
| S2Efun of (int(*npf*), s2explst, s2exp)
//
| S2Euni of
    (s2varlst, s2explst(*s2ps*), s2exp(*scope*))
| S2Eexi of
    (s2varlst, s2explst(*s2ps*), s2exp(*scope*))
//
| S2Etyrec of (tyreckind, int(*npf*), labs2explst)
//
| S2Eextype of (symbol)
| S2Eextkind of (symbol)
//
| S2Eerror of ((*for-error-indication*))
// end of [s2exp_node]
//
and
labs2exp =
  SLABELED of (label, s2exp)
//
where
s2exp = $rec{
  s2exp_srt= s2rt, s2exp_node= s2exp_node
} (* end of [s2exp] *)
//
and s2explst = List0 (s2exp)
and labs2explst = List0 (labs2exp)
//
(* ****** ****** *)
//
typedef s2expopt = Option(s2exp)
vtypedef s2expopt_vt = Option_vt(s2exp)
//
(* ****** ****** *)
//
fun
s2exp_make_node
  (s2t: s2rt, node: s2exp_node): s2exp
//
fun s2exp_var (s2v: s2var): s2exp
fun s2exp_eqeq (s2e1: s2exp, s2e2: s2exp): s2exp
//
(* ****** ****** *)

fun s2exp_is_impred (s2e: s2exp): bool

(* ****** ****** *)
//
fun print_s2exp(s2exp): void
and prerr_s2exp(s2exp): void
//
overload print with print_s2exp
overload prerr with prerr_s2exp
//
fun print_s2explst(s2explst): void
and prerr_s2explst(s2explst): void
//
overload print with print_s2explst
overload prerr with prerr_s2explst
//
fun fprint_s2exp : fprint_type(s2exp)
fun fprint_s2explst : fprint_type(s2explst)
//
overload fprint with fprint_s2exp
overload fprint with fprint_s2explst of 10
//
fun fprint_labs2exp : fprint_type(labs2exp)
fun fprint_labs2explst : fprint_type(labs2explst)
//
overload fprint with fprint_labs2exp
overload fprint with fprint_labs2explst of 10
//
(* ****** ****** *)

abstype d2var_type = ptr
typedef d2var = d2var_type

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

datatype
caskind =
  | CK_case // case
  | CK_case_pos // case+
  | CK_case_neg // case-
// end of [caskind]

datatype
c3nstrkind =
//
  | C3TKmain of () // generic
//
  | C3TKcase_exhaustiveness of (caskind)
//
  | C3TKtermet_isnat of () // term. metric welfounded
  | C3TKtermet_isdec of () // term. metric decreasing
//
  | C3TKsome_fin of (d2var, s2exp(*fin*), s2exp)
  | C3TKsome_lvar of (d2var, s2exp(*lvar*), s2exp)
  | C3TKsome_vbox of (d2var, s2exp(*vbox*), s2exp)
//
  | C3TKlstate of () // lstate merge
  | C3TKlstate_var of (d2var) // lstate merge for d2var
//
  | C3TKloop of (int) // HX: ~1/0/1: enter/break/continue
//
  | C3TKsolver of (int) // HX: knd=0/1: solassert/solverify
//
  | C3TKignored of () // HX-2015-06-06: ignored c3nstrkind
// end of [c3nstrkind]

datatype s3itm =
  | S3ITMsvar of s2var
  | S3ITMsVar of s2Var
  | S3ITMhypo of h3ypo
  | S3ITMcnstr of c3nstr
  | S3ITMcnstr_ref of (loc_t, c3nstropt)
  | S3ITMdisj of s3itmlstlst
//
  | S3ITMsolassert of (s2exp) // HX: $solver_assert
// end of [s3item]

and h3ypo_node =
  | H3YPOprop of s2exp
  | H3YPObind of (s2var, s2exp)
  | H3YPOeqeq of (s2exp, s2exp)
// end of [h3ypo_node]

and c3nstr_node =
  | C3NSTRprop of s2exp
  | C3NSTRitmlst of s3itmlst
  | C3NSTRsolverify of (s2exp) // HX: $solver_verify
// end of [c3nstr_node]

where
//
s3itmlst = List0(s3itm)
//
and
s3itmlstlst = List0(s3itmlst)
//
and
h3ypo = $rec{
  h3ypo_loc= loc_t
, h3ypo_node= h3ypo_node
} (* end of [h3ypo] *)
//
and
c3nstr = $rec{
  c3nstr_loc= loc_t
, c3nstr_kind= c3nstrkind
, c3nstr_node= c3nstr_node
} (* end of [c3nstr] *)
//
and c3nstropt = Option(c3nstr)

(* ****** ****** *)
//
fun
h3ypo_make_node (loc_t, h3ypo_node): h3ypo
//
(* ****** ****** *)
//
fun
c3nstr_make_node
  (loc: loc_t, knd: c3nstrkind, c3nstr_node): c3nstr
//
(* ****** ****** *)
//
fun
fprint_s3itm: fprint_type(s3itm)
fun
fprint_s3itmlst: fprint_type(s3itmlst)
fun
fprint_s3itmlstlst: fprint_type(s3itmlstlst)
//
overload fprint with fprint_s3itm
overload fprint with fprint_s3itmlst of 10
overload fprint with fprint_s3itmlstlst of 20
//
(* ****** ****** *)
//
fun
fprint_h3ypo: fprint_type(h3ypo)
//
overload fprint with fprint_h3ypo
//
(* ****** ****** *)
//
fun
fprint_c3nstr: fprint_type(c3nstr)
fun
fprint_c3nstropt: fprint_type(c3nstropt)
//
overload fprint with fprint_c3nstr
overload fprint with fprint_c3nstropt of 10
//
(* ****** ****** *)
//
// HX-2015-05-25:
// pretty-printing
//
fun fpprint_c3nstr: fprint_type(c3nstr)
//
(* ****** ****** *)

(* end of [patsolve_cnstrnt.sats] *)

(*
** ATS-extsolve:
** For solving ATS-constraints
** with external SMT-solvers
*)

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

(*
** Author: Hongwei Xi
** Authoremail: gmhwxiATgmailDOTcom
*)

(* ****** ****** *)
//
#define ATS_PACKNAME "PATSOLVE_CNSTRNT"
//
(* ****** ****** *)
//
abst0ype
stamp_t0ype = int
//
typedef stamp = stamp_t0ype
//
(* ****** ****** *)
//
fun print_stamp: stamp -> void
and prerr_stamp: stamp -> void
fun fprint_stamp: fprint_type(stamp)
//
overload print with print_stamp
overload prerr with prerr_stamp
overload fprint with fprint_stamp
//
(* ****** ****** *)

fun stamp_make(int): stamp

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

fun stamp_get_int(stamp): int

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

fun hash_stamp(stamp):<> ulint

(* ****** ****** *)
//
fun
eq_stamp_stamp : (stamp, stamp) -<fun0> bool
fun
neq_stamp_stamp : (stamp, stamp) -<fun0> bool
fun
compare_stamp_stamp : (stamp, stamp) -<fun0> int
//
overload = with eq_stamp_stamp
overload != with neq_stamp_stamp
overload compare with compare_stamp_stamp
//
(* ****** ****** *)
//
fun the_stamp_getinc(): stamp
//
fun the_stamp_update(n: stamp): void
//
(* ****** ****** *)

abstype symbol_type = ptr
typedef symbol = symbol_type

(* ****** ****** *)
//
fun print_symbol: symbol -> void
and prerr_symbol: symbol -> void
fun fprint_symbol: fprint_type(symbol)
//
overload print with print_symbol
overload prerr with prerr_symbol
overload fprint with fprint_symbol
//
(* ****** ****** *)

fun
symbol_make_name (string): symbol

(* ****** ****** *)
//
fun
symbol_get_name (symbol): string
//
overload .name with symbol_get_name
//
(* ****** ****** *)
//
fun
eq_symbol_symbol : (symbol, symbol) -<fun0> bool
fun
neq_symbol_symbol : (symbol, symbol) -<fun0> bool
fun
compare_symbol_symbol : (symbol, symbol) -<fun0> int
//
overload = with eq_symbol_symbol
overload != with neq_symbol_symbol
overload compare with compare_symbol_symbol
//
(* ****** ****** *)
//
abstype
location_type = ptr
//
typedef loc_t = location_type
//
(* ****** ****** *)
//
fun
fprint_location: fprint_type(loc_t)
//
overload fprint with fprint_location
//
(* ****** ****** *)
//
fun location_make (rep: string): loc_t
//
(* ****** ****** *)
//
datatype label =
  LABint of int | LABsym of symbol
//
(* ****** ****** *)
//
fun print_label : label -> void
and prerr_label : label -> void
fun fprint_label : fprint_type(label)
//
overload print with print_label
overload prerr with prerr_label
overload fprint with fprint_label
//
(* ****** ****** *)

datatype s2rt =
//
  | S2RTint of ()
  | S2RTaddr of ()
  | S2RTbool of ()
//
  | S2RTreal of ()
  | S2RTstring of ()
//
  | S2RTcls of ()
  | S2RTeff of ()
//
  | S2RTtup of ((*void*))
//
  | S2RTtype of ((*void*))
  | S2RTvtype of ((*void*))
//
  | S2RTt0ype of ((*void*))
  | S2RTvt0ype of ((*void*))
//
  | S2RTprop of ((*void*))
  | S2RTview of ((*void*))
//
  | S2RTtkind of ((*void*))
//
  | S2RTfun of (s2rtlst(*args*), s2rt (*res*))
//
  | S2RTnamed of (symbol)
//
  | S2RTerror of ((*void*))
//
// end of [datatype]

where s2rtlst = List0(s2rt)

(* ****** ****** *)
//
fun s2rt_int((*void*)): s2rt
fun s2rt_addr((*void*)): s2rt
fun s2rt_bool((*void*)): s2rt
//
fun s2rt_real((*void*)): s2rt
fun s2rt_string((*void*)): s2rt
//
(* ****** ****** *)
//
fun
s2rt_is_impred(s2t: s2rt): bool
//
(* ****** ****** *)
//
fun print_s2rt : s2rt -> void
and prerr_s2rt : s2rt -> void
fun fprint_s2rt: fprint_type(s2rt)
//
overload print with print_s2rt
overload prerr with prerr_s2rt
overload fprint with fprint_s2rt
//
(* ****** ****** *)
//
abstype
s2cst_type = ptr
//
typedef s2cst = s2cst_type
//
typedef s2cstlst = List0(s2cst)
vtypedef s2cstlst_vt = List0_vt(s2cst)
//
typedef s2cstopt = Option(s2cst)
vtypedef s2cstopt_vt = Option_vt(s2cst)
//
(* ****** ****** *)
//
fun
s2cst_make
  (symbol, s2rt, stamp): s2cst
//
(* ****** ****** *)
//
fun print_s2cst: s2cst -> void
and prerr_s2cst: s2cst -> void
fun fprint_s2cst: fprint_type(s2cst)
//
overload print with print_s2cst
overload prerr with prerr_s2cst
overload fprint with fprint_s2cst
//
(* ****** ****** *)
//
fun s2cst_get_srt (s2cst): s2rt
fun s2cst_get_name (s2cst): symbol
fun s2cst_get_stamp (s2cst): stamp
//
overload .srt with s2cst_get_srt
overload .name with s2cst_get_name
overload .stamp with s2cst_get_stamp
//
(* ****** ****** *)

fun s2cst_get_payload(s2cst): ptr
fun s2cst_set_payload(s2cst, payload: ptr): void

(* ****** ****** *)
//
abstype
s2var_type = ptr
//
typedef s2var = s2var_type
//
typedef s2varlst = List0(s2var)
vtypedef s2varlst_vt = List0_vt(s2var)
//
typedef s2varopt = Option(s2var)
vtypedef s2varopt_vt = Option_vt(s2var)
//
(* ****** ****** *)
//
fun
s2var_make
  (symbol, s2rt, stamp): s2var
//
(* ****** ****** *)
//
fun print_s2var: s2var -> void
and prerr_s2var: s2var -> void
fun fprint_s2var: fprint_type(s2var)
//
overload print with print_s2var
overload prerr with prerr_s2var
overload fprint with fprint_s2var
//
(* ****** ****** *)
//
fun
s2var_get_srt (s2var): s2rt
fun
s2var_get_name (s2var): symbol
fun
s2var_get_stamp (s2var): stamp
//
overload .srt with s2var_get_srt
overload .name with s2var_get_name
overload .stamp with s2var_get_stamp
//
(* ****** ****** *)

fun s2var_is_impred (s2v: s2var): bool

(* ****** ****** *)
//
fun s2var_get_payload(s2var): ptr
fun s2var_set_payload(s2var, payload: ptr): void
//
(* ****** ****** *)
//
abstype
s2Var_type = ptr
//
typedef s2Var = s2Var_type
//
typedef s2Varlst = List0(s2Var)
vtypedef s2Varlst_vt = List0_vt(s2Var)
//
typedef s2Varopt = Option(s2Var)
vtypedef s2Varopt_vt = Option_vt(s2Var)
//
(* ****** ****** *)
//
fun s2Var_make(stamp): s2Var
//
(* ****** ****** *)
//
fun print_s2Var: s2Var -> void
and prerr_s2Var: s2Var -> void
fun fprint_s2Var: fprint_type(s2Var)
//
overload print with print_s2Var
overload prerr with prerr_s2Var
overload fprint with fprint_s2Var
//
(* ****** ****** *)
//
fun
s2Var_get_stamp (s2Var): stamp
//
overload .stamp with s2Var_get_stamp
//
(* ****** ****** *)

datatype
tyreckind =
  | TYRECKINDbox (* boxed *)
  | TYRECKINDbox_lin (* boxed *)
  | TYRECKINDflt0 (* flat *)
  | TYRECKINDflt1 of stamp (* flat *)
  | TYRECKINDflt_ext of string  (* flat *)
// end of [tyreckind]

(* ****** ****** *)
//
fun tyreckind_is_box (knd: tyreckind): bool
fun tyreckind_is_box_lin (knd: tyreckind): bool
//
fun tyreckind_is_flt0 (knd: tyreckind): bool
fun tyreckind_is_flt1 (knd: tyreckind): bool
fun tyreckind_is_flt_ext (knd: tyreckind): bool
//
(* ****** ****** *)
//
fun
print_tyreckind : tyreckind -> void
and
prerr_tyreckind : tyreckind -> void
fun
fprint_tyreckind : fprint_type(tyreckind)
//
overload print with print_tyreckind
overload prerr with prerr_tyreckind
overload fprint with fprint_tyreckind
//
(* ****** ****** *)
//
datatype
s2exp_node =
//
| S2Eint of (int)
| S2Eintinf of (string)
//
| S2Ecst of (s2cst)
| S2Evar of (s2var)
| S2EVar of (s2Var)
//
| S2Eeqeq of (s2exp, s2exp)
//
| S2Esizeof of (s2exp(*t0ype*))
//
| S2Eapp of (s2exp, s2explst)
| S2Emetdec of
    (s2explst(*met*), s2explst(*bound*)) // strictly decreasing
  // end of [S2Emetdec]
//
| S2Etop of (int(*knd*), s2exp)
//
| S2Einvar of (s2exp)
//
| S2Efun of (int(*npf*), s2explst, s2exp)
//
| S2Euni of
    (s2varlst, s2explst(*s2ps*), s2exp(*scope*))
| S2Eexi of
    (s2varlst, s2explst(*s2ps*), s2exp(*scope*))
//
| S2Etyrec of (tyreckind, int(*npf*), labs2explst)
//
| S2Eextype of (symbol)
| S2Eextkind of (symbol)
//
| S2Eerror of ((*for-error-indication*))
// end of [s2exp_node]
//
and
labs2exp =
  SLABELED of (label, s2exp)
//
where
s2exp = $rec{
  s2exp_srt= s2rt, s2exp_node= s2exp_node
} (* end of [s2exp] *)
//
and s2explst = List0 (s2exp)
and labs2explst = List0 (labs2exp)
//
(* ****** ****** *)
//
typedef s2expopt = Option(s2exp)
vtypedef s2expopt_vt = Option_vt(s2exp)
//
(* ****** ****** *)
//
fun
s2exp_make_node
  (s2t: s2rt, node: s2exp_node): s2exp
//
fun s2exp_var (s2v: s2var): s2exp
fun s2exp_eqeq (s2e1: s2exp, s2e2: s2exp): s2exp
//
(* ****** ****** *)

fun s2exp_is_impred (s2e: s2exp): bool

(* ****** ****** *)
//
fun print_s2exp(s2exp): void
and prerr_s2exp(s2exp): void
//
overload print with print_s2exp
overload prerr with prerr_s2exp
//
fun print_s2explst(s2explst): void
and prerr_s2explst(s2explst): void
//
overload print with print_s2explst
overload prerr with prerr_s2explst
//
fun fprint_s2exp : fprint_type(s2exp)
fun fprint_s2explst : fprint_type(s2explst)
//
overload fprint with fprint_s2exp
overload fprint with fprint_s2explst of 10
//
fun fprint_labs2exp : fprint_type(labs2exp)
fun fprint_labs2explst : fprint_type(labs2explst)
//
overload fprint with fprint_labs2exp
overload fprint with fprint_labs2explst of 10
//
(* ****** ****** *)

abstype d2var_type = ptr
typedef d2var = d2var_type

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

datatype
caskind =
  | CK_case // case
  | CK_case_pos // case+
  | CK_case_neg // case-
// end of [caskind]

datatype
c3nstrkind =
//
  | C3TKmain of () // generic
//
  | C3TKcase_exhaustiveness of (caskind)
//
  | C3TKtermet_isnat of () // term. metric welfounded
  | C3TKtermet_isdec of () // term. metric decreasing
//
  | C3TKsome_fin of (d2var, s2exp(*fin*), s2exp)
  | C3TKsome_lvar of (d2var, s2exp(*lvar*), s2exp)
  | C3TKsome_vbox of (d2var, s2exp(*vbox*), s2exp)
//
  | C3TKlstate of () // lstate merge
  | C3TKlstate_var of (d2var) // lstate merge for d2var
//
  | C3TKloop of (int) // HX: ~1/0/1: enter/break/continue
//
  | C3TKsolver of (int) // HX: knd=0/1: solassert/solverify
//
  | C3TKignored of () // HX-2015-06-06: ignored c3nstrkind
// end of [c3nstrkind]

datatype s3itm =
  | S3ITMsvar of s2var
  | S3ITMsVar of s2Var
  | S3ITMhypo of h3ypo
  | S3ITMcnstr of c3nstr
  | S3ITMcnstr_ref of (loc_t, c3nstropt)
  | S3ITMdisj of s3itmlstlst
//
  | S3ITMsolassert of (s2exp) // HX: $solver_assert
// end of [s3item]

and h3ypo_node =
  | H3YPOprop of s2exp
  | H3YPObind of (s2var, s2exp)
  | H3YPOeqeq of (s2exp, s2exp)
// end of [h3ypo_node]

and c3nstr_node =
  | C3NSTRprop of s2exp
  | C3NSTRitmlst of s3itmlst
  | C3NSTRsolverify of (s2exp) // HX: $solver_verify
// end of [c3nstr_node]

where
//
s3itmlst = List0(s3itm)
//
and
s3itmlstlst = List0(s3itmlst)
//
and
h3ypo = $rec{
  h3ypo_loc= loc_t
, h3ypo_node= h3ypo_node
} (* end of [h3ypo] *)
//
and
c3nstr = $rec{
  c3nstr_loc= loc_t
, c3nstr_kind= c3nstrkind
, c3nstr_node= c3nstr_node
} (* end of [c3nstr] *)
//
and c3nstropt = Option(c3nstr)

(* ****** ****** *)
//
fun
h3ypo_make_node (loc_t, h3ypo_node): h3ypo
//
(* ****** ****** *)
//
fun
c3nstr_make_node
  (loc: loc_t, knd: c3nstrkind, c3nstr_node): c3nstr
//
(* ****** ****** *)
//
fun
fprint_s3itm: fprint_type(s3itm)
fun
fprint_s3itmlst: fprint_type(s3itmlst)
fun
fprint_s3itmlstlst: fprint_type(s3itmlstlst)
//
overload fprint with fprint_s3itm
overload fprint with fprint_s3itmlst of 10
overload fprint with fprint_s3itmlstlst of 20
//
(* ****** ****** *)
//
fun
fprint_h3ypo: fprint_type(h3ypo)
//
overload fprint with fprint_h3ypo
//
(* ****** ****** *)
//
fun
fprint_c3nstr: fprint_type(c3nstr)
fun
fprint_c3nstropt: fprint_type(c3nstropt)
//
overload fprint with fprint_c3nstr
overload fprint with fprint_c3nstropt of 10
//
(* ****** ****** *)
//
// HX-2015-05-25:
// pretty-printing
//
fun fpprint_c3nstr: fprint_type(c3nstr)
//
(* ****** ****** *)

(* end of [patsolve_cnstrnt.sats] *)


Updating: very minorly improving

Updating: very minorly improving

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

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

(*
** Permission to use, copy, modify, and distribute this software for any
** purpose with or without fee is hereby granted, provided that the above
** copyright notice and this permission notice appear in all copies.
**
** THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
** WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
** MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
** ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
** WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
** ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
** OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)

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

(*
** Author: Hongwei Xi
** Authoremail: gmhwxi AT gmail DOT com
** Start Time: October, 2015
*)

(* ****** ****** *)
//
// HX-2015-10-25:
//
(* ****** ****** *)

#define
ATS_STALOADFLAG 0 // no staloading at run-time
#define
ATS_EXTERN_PREFIX "ats2js_worker_" // prefix for external names

(* ****** ****** *)
//
staload
"libats/ML/SATS/basis.sats"
//
(* ****** ****** *)
//
abstype
chmsg_type(a:t@ype+)
//
typedef
chmsg(a:t0p) = chmsg_type(a)
//
(* ****** ****** *)
//
abstype chanpos()
abstype channeg()
//
(* ****** ****** *)
//
typedef
chpcont0() = cfun1(chanpos(), void)
typedef
chpcont1(a:t0p) = cfun2(chanpos(), a, void)
//
(* ****** ****** *)
//
typedef
chncont0() = cfun1(channeg(), void)
typedef
chncont1(a:t0p) = cfun2(channeg(), a, void)
//
(* ****** ****** *)
//
fun{a:t0p}
chmsg_parse(chmsg(INV(a))): (a)
//
(* ****** ****** *)

fun
chanpos0_close(chanpos()): void = "mac#%"

(* ****** ****** *)
//
fun
chanpos0_send
  {a:t0p}
(
  chanpos(), x0: a, k0: chpcont0()
) : void = "mac#%" // end-of-fun
//
fun
chanpos0_recv
  {a:t0p}
(
  chanpos(), k0: chpcont1(chmsg(a))
) : void = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun
channeg0_new_file
  (filename: string): channeg() = "mac#%"
//
fun
channeg0_close(channeg((*nil*))): void = "mac#%"
//
(* ****** ****** *)
//
fun
channeg0_recv
  {a:t0p}
(
  channeg(), x0: a, k0: chncont0()
) : void = "mac#%" // end-of-fun
//
fun
channeg0_send
  {a:t0p}
(
  channeg(), k0: chncont1(chmsg(a))
) : void = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun
{a:t0p}
{b:t0p}
rpc_server
  (chanpos(), fopr: (a) -<cloref1> b): void = "mac#%"
//
fun
{a:t0p}
{b:t0p}
rpc_server_cont
  (chanpos(), fopr: (a) -<cloref1> b): void = "mac#%"
//
(* ****** ****** *)
//
fun
{a:t0p}
{b:t0p}
rpc_client
  (channeg(), a, (b) -<cloref1> void): void = "mac#%"
//
(* ****** ****** *)
//
abstype chsnd(a:vt@ype)
abstype chrcv(a:vt@ype)
//
abstype chnil
abstype chcons(a:type, ss:type)
//
stadef :: = chcons
//
(* ****** ****** *)
//
(*
abstype ssnot(ss:type)
*)
//
abstype ssconj(ss:type)
abstype ssdisj(ss:type)
//
abstype ssdisj_nil and ssconj_nil
//
(* ****** ****** *)

abstype ssrepeat0(ss:type)
abstype ssrepeat1(ss:type)

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

absvtype chanpos(ss:type)
absvtype channeg(ss:type)

(* ****** ****** *)
//
typedef
chpcont0(ss:type) = cfun1(chanpos(ss), void)
typedef
chpcont1(ss:type, a:t0p) = cfun2(chanpos(ss), a, void)
//
typedef
chncont0(ss:type) = cfun1(channeg(ss), void)
typedef
chncont1(ss:type, a:t0p) = cfun2(channeg(ss), a, void)
//
(* ****** ****** *)
//
fun
chanpos1_send
  {a:t0p}{ss:type}
(
  chanpos(chsnd(a)::ss), x0: a, k0: chpcont0(ss)
) : void = "mac#%" // end-of-fun
//
fun
chanpos1_recv
  {a:t0p}{ss:type}
(
  chanpos(chrcv(a)::ss), k0: chpcont1(ss, chmsg(a))
) : void = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun
channeg1_recv
  {a:t0p}{ss:type}
(
  channeg(chrcv(a)::ss), x0: a, k0: chncont0(ss)
) : void = "mac#%" // end-of-fun
//
fun
channeg1_send
  {a:t0p}{ss:type}
(
  channeg(chsnd(a)::ss), k0: chncont1(ss, chmsg(a))
) : void = "mac#%" // end-of-fun
//
(* ****** ****** *)
//
fun chanpos1_close(chanpos(chnil)): void = "mac#%"
fun channeg1_close(channeg(chnil)): void = "mac#%"
//
(* ****** ****** *)

(* end of [channel.sats] *)

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

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

(*
** Permission to use, copy, modify, and distribute this software for any
** purpose with or without fee is hereby granted, provided that the above
** copyright notice and this permission notice appear in all copies.
**
** THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
** WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
** MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
** ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
** WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
** ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
** OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)

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

(*
** Author: Hongwei Xi
** Authoremail: gmhwxi AT gmail DOT com
** Start Time: October, 2015
*)

(* ****** ****** *)
//
// HX-2015-10-25:
//
(* ****** ****** *)

#define
ATS_STALOADFLAG 0 // no staloading at run-time
#define
ATS_EXTERN_PREFIX "ats2js_worker_" // prefix for external names

(* ****** ****** *)
//
staload
"libats/ML/SATS/basis.sats"
//
(* ****** ****** *)
//
abstype
chmsg_type(a:t@ype+)
//
typedef
chmsg(a:t0p) = chmsg_type(a)
//
(* ****** ****** *)
//
abstype chanpos()
abstype channeg()
//
(* ****** ****** *)
//
typedef
chpcont0() = cfun1(chanpos(), void)
typedef
chpcont1(a:t0p) = cfun2(chanpos(), a, void)
//
(* ****** ****** *)
//
typedef
chncont0() = cfun1(channeg(), void)
typedef
chncont1(a:t0p) = cfun2(channeg(), a, void)
//
(* ****** ****** *)
//
fun{a:t0p}
chmsg_parse(chmsg(INV(a))): (a)
//
(* ****** ****** *)

fun
chanpos0_close(chanpos()): void = "mac#%"

(* ****** ****** *)
//
fun
chanpos0_send
  {a:t0p}
(
  chanpos(), x0: a, k0: chpcont0()
) : void = "mac#%" // end-of-fun
//
fun
chanpos0_recv
  {a:t0p}
  (chanpos(), k0: chpcont1(chmsg(a))): void = "mac#%"
//
(* ****** ****** *)
//
fun
channeg0_new_file
  (filename: string): channeg() = "mac#%"
//
fun
channeg0_close(channeg((*nil*))): void = "mac#%"
//
(* ****** ****** *)
//
fun
channeg0_recv
  {a:t0p}
(
  channeg(), x0: a, k0: chncont0()
) : void = "mac#%" // end-of-fun
//
fun
channeg0_send
  {a:t0p}
  (channeg(), k0: chncont1(chmsg(a))): void = "mac#%"
//
(* ****** ****** *)
//
fun
{a:t0p}
{b:t0p}
rpc_server
  (chanpos(), fopr: (a) -<cloref1> b): void = "mac#%"
//
fun
{a:t0p}
{b:t0p}
rpc_server_cont
  (chanpos(), fopr: (a) -<cloref1> b): void = "mac#%"
//
(* ****** ****** *)
//
fun
{a:t0p}
{b:t0p}
rpc_client
  (channeg(), a, (b) -<cloref1> void): void = "mac#%"
//
(* ****** ****** *)
//
abstype chsnd(a:vt@ype)
abstype chrcv(a:vt@ype)
//
abstype chnil
abstype chcons(a:type, ss:type)
//
stadef :: = chcons
//
(* ****** ****** *)
//
(*
abstype ssnot(ss:type)
*)
//
abstype ssconj(ss:type)
abstype ssdisj(ss:type)
//
abstype ssdisj_nil and ssconj_nil
//
(* ****** ****** *)

abstype ssrepeat0(ss:type)
abstype ssrepeat1(ss:type)

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

absvtype chanpos(ss:type)
absvtype channeg(ss:type)

(* ****** ****** *)
//
typedef
chpcont0(ss:type) = cfun1(chanpos(ss), void)
typedef
chpcont1(ss:type, a:t0p) = cfun2(chanpos(ss), a, void)
//
typedef
chncont0(ss:type) = cfun1(channeg(ss), void)
typedef
chncont1(ss:type, a:t0p) = cfun2(channeg(ss), a, void)
//
(* ****** ****** *)
//
fun
chanpos1_send
  {a:t0p}{ss:type}
(
  chanpos(chsnd(a)::ss), x0: a, k0: chpcont0(ss)
) : void = "mac#%" // end-of-fun
//
fun
chanpos1_recv
  {a:t0p}{ss:type}
  (chanpos(chrcv(a)::ss), k0: chpcont1(ss, chmsg(a))): void = "mac#%"
//
(* ****** ****** *)
//
fun
channeg1_recv
  {a:t0p}{ss:type}
(
  channeg(chrcv(a)::ss), x0: a, k0: chncont0(ss)
) : void = "mac#%" // end-of-fun
//
fun
channeg1_send
  {a:t0p}{ss:type}
  (channeg(chsnd(a)::ss), k0: chncont1(ss, chmsg(a))): void = "mac#%"
//
(* ****** ****** *)
//
fun chanpos1_close(chanpos(chnil)): void = "mac#%"
fun channeg1_close(channeg(chnil)): void = "mac#%"
//
(* ****** ****** *)

(* end of [channel.sats] *)