Moving all preprocessor definitions outside of namespace/class defs.

(* ****** ****** *)
//
// ATS-parse-emit-python
//
(* ****** ****** *)
//
// AS-2014-08-17: start
//
(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
staload "./atsparemit.sats"
staload "./atsparemit_cil.sats"
staload "./atsparemit_syntax.sats"
staload "./atsparemit_syntax_cil.sats"
//
(* ****** ****** *)
//
staload "./atsparemit_emit.sats"
//
(* ****** ****** *)
//
staload "./atsparemit_typedef.dats"
//
(* ****** ****** *)

implement
emit_ENDL (out) = emit_text (out, "\n")

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

implement
emit_SPACE (out) = emit_text (out, " ")

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

implement
emit_SHARP (out) = emit_text (out, "#")

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

implement
emit_COLON (out) = emit_text (out, ":")

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

implement
emit_LPAREN (out) = emit_text (out, "(")
implement
emit_RPAREN (out) = emit_text (out, ")")

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

implement
emit_LBRACE (out) = emit_text (out, "{")
implement
emit_RBRACE (out) = emit_text (out, "}")

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

implement
emit_LBRACKET (out) = emit_text (out, "[")
implement
emit_RBRACKET (out) = emit_text (out, "]")

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

implement
emit_flush (out) = fileref_flush (out)
implement
emit_newline (out) = fprint_newline (out)

(* ****** ****** *)
//
implement
emit_int (out, x) = fprint_int (out, x)
//
implement
emit_text (out, x) = fprint_string (out, x)
//
(* ****** ****** *)
//
implement
emit_symbol (out, x) =
  fprint_string (out, symbol_get_name (x))
//
(* ****** ****** *)

implement
emit_PMVint
  (out, tok) = let
//
val-T_INT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVint]

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

implement
emit_PMVi0nt
  (out, tok) = let
//
val-T_INT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVi0nt]

(* ****** ****** *)
//
implement
emit_PMVbool
  (out, tfv) =
(
  emit_text (out, if tfv then "1" else "0")
) (* end of [emit_PMVbool] *)
//
(* ****** ****** *)
implement
emit_PMVstring
  (out, tok) = let
//
val-T_STRING(rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVstring]

(* ****** ****** *)
//
implement
emit_i0de
  (out, id) = emit_symbol (out, id.i0de_sym)
implement
emit_label
  (out, lab) = emit_symbol (out, lab.i0de_sym)
fun
emit_label_mark
  (out, lab) =
  {
    val () = emit_label (out, lab)
    val () = emit_COLON (out)
    val () = emit_ENDL (out)
  }
//
(* ****** ****** *)

implement
emit_extcode
  (out, toks) = let
//
fun
auxtok
(
  out: FILEref, tok: token
) : void =
(
case+
tok.token_node of
//
| T_KWORD _ => ()
//
| T_ENDL () => emit_ENDL (out)
| T_SPACES (cs) => emit_text (out, cs)
//
| T_COMMENT_line () =>
    emit_text (out, "// COMMENT_line\n")
| T_COMMENT_block () => ((*ignored*))
//
| T_INT (_, rep) => emit_text (out, rep)
//
| T_STRING (str) => emit_text (out, str)
//
| T_IDENT_alp (name) => emit_text (out, name)
| T_IDENT_srp (name) => emit_text (out, name) // FIXME?
//
| T_IDENT_sym (name) => emit_text (out, name)
//
| T_LPAREN () => emit_LPAREN (out)
| T_RPAREN () => emit_RPAREN (out)
//
| T_LBRACKET () => emit_LBRACKET (out)
| T_RBRACKET () => emit_RBRACKET (out)
//
| T_LBRACE () => emit_LBRACE (out)
| T_RBRACE () => emit_RBRACE (out)
//
| T_LT () => emit_text (out, "<")
| T_GT () => emit_text (out, ">")
//
| T_MINUS () => emit_text (out, "-")
//
| T_COLON () => emit_text (out, ":")
//
| T_COMMA () => emit_text (out, ",")
| T_SEMICOLON () => emit_text (out, ";")
//
| T_SLASH () => emit_text (out, "/")
//
| _ (*unrecognized*) =>
  {
    val () = fprint! (out, "TOKERR(", tok, ")")
  }
) (* end of [auxtok] *)
//
in
//
case+ toks of
| list_nil () => ()
| list_cons (tok, toks) =>
  (
    auxtok (out, tok); emit_extcode (out, toks)
  ) (* end of [list_cons] *)
//
end // end of [emit_extcode]

(* ****** ****** *)
//
extern
fun
emit_s0exp : emit_type (s0exp)
extern
fun
emit_s0explst : emit_type (s0explst)
//
extern
fun emit_tmpvar_ld (out: FILEref, tmp: i0de): void
//
extern
fun emit_tmpvar_st (out: FILEref, tmp: i0de): void
//
implement
  emit_tmpvar_ld (out, tmp) =
  {
    val () =
      case+ 0 of
      | _ when strstr(g1ofg0(symbol_get_name(tmp.i0de_sym)), "__dynloadflag") >= 0 =>
        {
          val () = emit_text (out, "ldsfld int32 ")
          val () = emit_text (out, the_clsname_get ())
        }
      | _ when tmpvar_is_sta (tmp.i0de_sym) =>
        {
          val () = emit_text (out, "ldsfld")
          val-~Some_vt(s0e) = statmps0exp_search_opt (tmp.i0de_sym)
          val () = emit_SPACE (out)
          val () = emit_s0exp (out, s0e)
          val () = emit_SPACE (out)
          val () = emit_text (out, the_clsname_get ())
        }
      | _ when tmpvar_is_arg (tmp.i0de_sym) =>
        {
          val () = emit_text (out, "ldarg")
        }
      | _ (*otherwise*) =>
        {
          val () =  emit_text (out, "ldloc")
        }
    // end of [val]
    val () = emit_SPACE (out)
    val () = emit_i0de (out, tmp)
  } // end of [emit_tmpvar_ld]
//
implement
  emit_tmpvar_st
    (out, tmp) =
  {
    val () =
      case+ 0 of
      | _ when strstr(g1ofg0(symbol_get_name(tmp.i0de_sym)), "__dynloadflag") >= 0 =>
        {
          val () = emit_text (out, "stsfld int32 ")
          val () = emit_text (out, the_clsname_get ())
          val () = println!("the_clsname_get() = ", the_clsname_get())
        }
      | _ when tmpvar_is_sta (tmp.i0de_sym) =>
        {
          val () = emit_text (out, "stsfld")
          val-~Some_vt(s0e) = statmps0exp_search_opt (tmp.i0de_sym)
          val () = emit_SPACE (out)
          val () = emit_s0exp (out, s0e)
          val () = emit_SPACE (out)
          val () = emit_text (out, the_clsname_get ())
        }
      | _ when tmpvar_is_arg (tmp.i0de_sym) =>
        {
          val () = emit_text (out, "starg")
        }
      | _(*otherwise*) =>
        {
          val () = emit_text (out, "stloc")
        }
    // end of [val]
    val () = emit_SPACE (out)
    val () = emit_i0de (out, tmp)
  } // end of [emit_tmpvar_st]
//
(* ****** ****** *)
//
extern
fun emit_MODCLSNAME (out: FILEref, fname: string): void
//
implement
  emit_MODCLSNAME (out, fname) = {
  val () = emit_text (out, "\'")
  // TODO: sanitize?
  val () = emit_text (out, fname)
  val () = emit_text (out, "\'")
} (* end of [emit_MODCLSNAME] *)
//
(* ****** ****** *)
//
extern
fun
emit_branchseqlst
  (out: FILEref, inss: instrlst, labthis: label, labnext: label): void
//
extern
fun
emit_instrlst
  (out: FILEref, inss: instrlst, labbeg: label, labend: label, marklab: bool) : void
//
(* ****** ****** *)
//
implement
emit_s0exp
  (out, s0e) = let
//
//
in
//
case+
s0e.s0exp_node of
//
| S0Eide (id) => emit_symbol (out, id)
| S0Elist (s0es) => () // shouldn't happen? marked as "temp"
| S0Eappid (id, s0es) =>
    // FIXME: what about other types? e.g. array types? struct types?
(
  case+ symbol_get_name (id.i0de_sym) of
  | "atstkind_t0ype" =>
    {
      // unboxed type, of sort t@ype in ATS
      val-list_cons (s0e, list_nil ()) = s0es
      val-S0Eide (id) = s0e.s0exp_node
      val () = emit_symbol (out, id)
    } (* end of [atstkind_t0ype] *)
  | _ =>
    {
      val () = emit_i0de (out, id)
      val () = emit_LPAREN (out)
      val () = emit_s0explst (out, s0es)
      val () = emit_RPAREN (out)
    } // end of [_]
)
//
end // end of [emit_s0exp]
//
(* ****** ****** *)

implement
emit_s0explst
  (out, s0es) = let
//
fun
loop
(
  out: FILEref, s0es: s0explst, i: int
) : void =
(
case+ s0es of
| list_nil () => ()
| list_cons (s0e, s0es) => let
    val () =
      if i > 0 then emit_text (out, ", ")
    // end of [val]
  in
    emit_s0exp (out, s0e); loop (out, s0es, i+1)
  end // end of [list_cons]
)
//
in
  loop (out, s0es, 0)
end // end of [emit_s0explst]

(* ****** ****** *)
//
extern
fun
funlab_get_index (fl: label): int
extern
fun
tmplab_get_index (lab: label): int
//
(* ****** ****** *)
//
extern
fun
the_f0arglst_get (): f0arglst
extern
fun
the_f0arglst_set (f0as: f0arglst): void
//
(* ****** ****** *)
//
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 (labs: labelist): void
//
(* ****** ****** *)
//
extern
fun
the_caseofseqlst_get (): instrlst
extern
fun
the_caseofseqlst_set (inss: instrlst): void
//
(* ****** ****** *)

local
//
val the_f0arglst = ref<f0arglst> (list_nil)
val the_tmpdeclst = ref<tmpdeclst> (list_nil)
//
val the_funbodylst = ref<instrlst> (list_nil)
//
val the_branchlablst = ref<labelist> (list_nil)
val the_caseofseqlst = ref<instrlst> (list_nil)
//
in (* in-of-local *)

implement
the_f0arglst_get () = !the_f0arglst
implement
the_f0arglst_set (xs) = !the_f0arglst := xs

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 () = !the_branchlablst
implement
the_branchlablst_set (xs) = !the_branchlablst := xs

implement
the_caseofseqlst_get () = !the_caseofseqlst
implement
the_caseofseqlst_set (xs) = !the_caseofseqlst := xs

end // end of [local]

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

local

fun
loop
(
  out: FILEref, d0es: d0explst, i: int
) : void =
(
case+ d0es of
| list_nil () => ()
| list_cons (d0e, d0es) => let
    val () =
      if i > 0 then emit_newline (out)
    // end of [val]
  in
    emit_d0exp (out, d0e);
    emit_newline (out);
    loop (out, d0es, i+1)
  end // end of [list_cons]
)

in (* in-of-local *)

implement
emit_d0explst (out, d0es) = loop (out, d0es, 0)
implement
emit_d0explst_1 (out, d0es) = loop (out, d0es, 1)

end // end of [local]

(* ******* ****** *)
//
extern
fun emit_f0arg : emit_type (f0arg)
extern
fun emit_f0marg : emit_type (f0marg)
extern
fun emit_f0head (out: FILEref, f0h: f0head, full: bool): void

//
(* ****** ****** *)

implement
emit_d0exp
  (out, d0e) = let
in
//
case+
d0e.d0exp_node of
//
| D0Eide (id) =>
  {
    val () = emit_tmpvar_ld (out, id)
  }
//
| D0Eappid (id, d0es) => let
    val () = emit_d0explst (out, d0es)

    // need type for [id]
    // what is [tyrec] type for?
    // val-~Some_vt (s0rec) = typedef_search_opt (id.i0de_sym)

    val f0head_opt = f0head_search_opt (id.i0de_sym)
  in
    case+ f0head_opt of
    | ~None_vt() =>
      {
        val () =
        (
          case+ symbol_get_name (id.i0de_sym) of
          //
          | "ATSCKnot" =>
            {
              val () = emit_text (out, "not")
            }
          | "ATSCKiseqz" =>
            {
              val () = emit_text (out, "ldc.i4.0")
              val () = emit_ENDL (out)
              val () = emit_text (out, "ceq")
            }
          | "ATSCKisneqz" =>
            {
              val () = emit_text (out, "ldc.i4.0")
              val () = emit_ENDL (out)
              val () = emit_text (out, "ceq")
              val () = emit_ENDL (out)
              val () = emit_text (out, "not")
            }
          (*
          // TODO:
          | "ATSCKptriscons"
          | "ATSCKptrisnull"
          *)
          // TODO: ATSCKpat_(con*|exn*)
          //
          | _ when strstr(g1ofg0(symbol_get_name(id.i0de_sym)), "__dynload") >= 0 =>
            {
              val () = emit_text (out, "call void ")
              val () = emit_text (out, the_clsname_get ())
              val () = emit_i0de (out, id)
              val () = emit_text (out, "()")
            } // end of [dynload]
          | _ =>
            {
              val () = emit_text (out, "call")
              val () = emit_SPACE (out)
              // leave the identifier as-is, to be resolved manually by the programmer
              val () = emit_i0de (out, id)
            }
        ) (* end of [val] *)
      }
    | ~Some_vt(fhd) =>
      {
        val () = emit_text (out, "call")
        val () = emit_SPACE (out)
        val () = emit_f0head (out, fhd, true)
      }
  end // end of [D0Eappid]
//
// TODO: D0Elist
//
| ATSempty (x) => emit_text (out, "ldnull")
//
| ATSPMVint (tok) =>
  {
    val () = emit_text (out, "ldc.i4")
    val () = emit_SPACE (out)
    val () = emit_PMVint (out, tok)
  } (* end of [ATSPMVint] *)
| ATSPMVi0nt (tok) =>
  {
    val-T_INT(base, rep) = tok.token_node
    val () = emit_text (out, "ldc.i4")
    val () = emit_SPACE (out)
    val () = emit_text (out, rep)
  } (* end of [ATSPMVi0nt] *)
//
| ATSPMVbool (tfv) =>
  {
    val () = emit_text (out, "ldc.i4")
    val () = emit_SPACE (out)
    val () = emit_PMVbool (out, tfv)
  } (* end of [ATSPMVbool] *)
//
| ATSPMVstring (tok) =>
  {
    val () = emit_text (out, "ldstr")
    val () = emit_SPACE(out)
    val () = emit_PMVstring (out, tok)
  } (* end of [ATSPMVstring] *)
//
| ATSPMVf0loat (tok) =>
  {
    val-T_FLOAT(base, rep) = tok.token_node
    val () = emit_text (out, "ldc.r4")
    val () = emit_SPACE (out)
    val () = emit_text (out, rep)
  }
//
| _ => emit_text (out, "**D0EXP**")
//
end // end of [emit_d0exp]

(* ****** ****** *)
//
extern
fun emit_f0body : emit_type (f0body)
//
(* ****** ****** *)

implement
emit_f0arg
  (out, f0a) = let
in
//
case+
f0a.f0arg_node of
//
| F0ARGnone s0e => emit_s0exp (out, s0e)
| F0ARGsome (id, s0e) =>
  {
    val () = emit_s0exp (out, s0e)
    val () = emit_SPACE (out)
    val () = emit_i0de (out, id)
  } (* end of [F0ARGsome] *)
//
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, full) = let
//
val f0as =
  f0head_get_f0arglst (fhd)
//
val () = the_f0arglst_set (f0as)
//
in
//
case+
fhd.f0head_node of
| F0HEAD
    (id(*name of function*), f0ma(*list of arguments*), res(*result type*)) =>
  {
    val () = emit_s0exp (out, res)
    val () = emit_SPACE (out)
    val () =
      if full then emit_text (out, the_clsname_get ())
    // end of [val]
    val () = emit_i0de (out, id)
    val () = emit_LPAREN (out)
    val () = emit_f0marg (out, f0ma)
    val () = emit_RPAREN (out)
  }
//
end // end of [emit_f0head]

(* ****** ****** *)
//
extern
fun
emit_tmpdeclst
  (out: FILEref, tds: tmpdeclst): void
//
implement
emit_tmpdeclst
  (out, tds) = let
//
fun auxlst
(
  out: FILEref, tds: tmpdeclst, i: int
) : void =
(
case+ tds of
| list_nil () => ()
| list_cons (td, tds) =>
  (
    case+ td.tmpdec_node of
    | TMPDECnone
        (tmp) => auxlst (out, tds, i) // probably ATStmpdec_void()
    | TMPDECsome
        (tmp, s0e) => let
        val () =
          if i > 0 then
            emit_text(out, ", ")
        // end of [val]
        val () = emit_s0exp (out, s0e)
        val () = emit_SPACE (out)
        val () = emit_i0de (out, tmp)
        val () = emit_newline (out)
      in
        auxlst (out, tds, i+1)
      end // end of [TMPDECsome]
  ) (* end of [list_cons] *)
)
//
in
  auxlst (out, tds, 0)
end // end of [emit_tmpdeclst_initize]
//
(* ****** ****** *)
//
extern
fun emit_instr_0
  (out: FILEref, ins: instr): void
//
implement
emit_instr_0
  (out, ins0) = let
in
//
case+
ins0.instr_node of
//
| ATSreturn (tmp) =>
  {
    val () = emit_tmpvar_ld (out, tmp)
    val () = emit_newline (out)
    val () = emit_text (out, "ret")
  }
//
| ATSreturn_void (tmp) =>
  {
    val () = emit_text (out, "ret")
  }
//
| _ => emit_text (out, "**INSTR**")
//
end // end of [emit_instr_0]
//
extern
fun emit_instr
  (out: FILEref, ins: instr, labthis: label, labnext: label) : void
//
implement
emit_instr
  (out, ins0, labthis, labnext) = let
in
//
case+
ins0.instr_node of
//
| ATSif
  (
    d0e(*test*), inss(*then*), inssopt(*else*)
  ) =>
  (
    emit_d0exp (out, d0e);
    emit_newline (out);

    case+ inssopt of
    | Some (inss2) =>
      {
        val () = emit_text (out, "brfalse")
        val () = emit_SPACE (out)
        val L1 = label_for_instrlst (inss2)
        val () = emit_label (out, L1)
        val () = emit_ENDL (out)
        val L0 = label_for_instrlst (inss)
        val brlab = make_label (ins0.instr_loc)
        val () = emit_instrlst (out, inss, L0, brlab, true)
        val () = emit_label_mark (out, brlab)
        val () = emit_text (out, "br")
        val () = emit_SPACE (out)
        val () = emit_label (out, labnext)
        val () = emit_ENDL (out)
        val () = emit_instrlst (out, inss2, L1, labnext, true)
      }
    | None () =>
      {
        val () = emit_text (out, "brfalse")
        val () = emit_SPACE (out)
        val () = emit_label (out, labnext)
        val () = emit_ENDL (out)
        val brlab = make_label (ins0.instr_loc)
        val () = emit_instrlst (out, inss, brlab, labnext, true)
      }
  )
//
| ATSifthen (d0e, inss) =>
  {
//
    val-list_cons (ins, _) = inss
//
    val () = emit_d0exp (out, d0e)
    val () = emit_ENDL (out)
    val () = emit_text (out, "brfalse")
    val () = emit_SPACE (out)
    val () = emit_label (out, labnext)
    val () = emit_ENDL (out)
    val brlab = make_label (ins.instr_loc)
    val () = emit_instr (out, ins, brlab, labnext)
  }
| ATSifnthen (d0e, inss) =>
  {
//
    val-list_cons (ins, _) = inss
//
    val () = emit_d0exp (out, d0e)
    val () = emit_ENDL (out)
    val () = emit_text (out, "brtrue")
    val () = emit_SPACE (out)
    val () = emit_label (out, labnext)
    val () = emit_ENDL (out)
    val brlab = make_label (ins.instr_loc)
    val () = emit_instr (out, ins, brlab, labnext)
  }
//
| ATSbranchseq (inss) =>
  {
    val () = emit_text (out, "/* ATSbranch */")
  }
//
| ATScaseofseq (inss) =>
  {
    val () = emit_text (out, "/* ATScaseofseq_beg */\n")
    val () = emit_branchseqlst (out, inss, labthis, labnext)
    val () = emit_text (out, "/* ATScaseofseq_end */\n")
  }
//
// TODO: ATSlinepragma
//
| ATSreturn (tmp) =>
  {
    val () =
      if tmpvar_is_arg (tmp.i0de_sym)
        then emit_text (out, "ldarg")
        else emit_text (out, "ldloc")
    // end of [val]
    val () = emit_SPACE (out)
    val () = emit_i0de (out, tmp)
    val () = emit_newline (out)
    val () = emit_text (out, "ret")
  }
//
| ATSreturn_void (tmp) =>
  {
    val () = emit_text (out, "ret")
  }
//
(*
| ATSlinepragma (line, file) =>
  {
    val () = emit_text (out, ".line")
    val () = emit_SPACE (out)
    val-T_INT(_, lpos) = line.token_node
    val () = emit_text (out, lpos)
    val () = emit_SPACE (out)
    val-T_STRING(filnam) = file.token_node
    val () = emit_text (out, filnam)
  }
*)
//
(*
| ATSINSlab (lab) =>
  {
    val () = emit_label_mark (out, lab)
  }
*)
//
| ATSINSgoto (lab) =>
  {
    val () = emit_text (out, "br")
    val () = emit_SPACE (out)
    val () = emit_label (out, lab)
  }
//
(*
| ATSINSflab (flab) =>
  {
    val () = emit_label_mark (out, flab)
  }
*)
//
| ATSINSfgoto (flab) =>
  {
    val () = emit_text (out, "br")
    val () = emit_SPACE (out)
    val () = emit_label (out, flab)
  }
//
| ATSINSmove (tmp, d0e) =>
  {
    val () = emit_d0exp (out, d0e)
    val () = emit_newline (out)
    val () = emit_tmpvar_st (out, tmp)
  } (* end of [ATSINSmove] *)
| ATSINSmove_void (_, d0e) =>
  {
    val () = emit_d0exp (out, d0e)
  } (* end of [ATSINSmove_void] *)
//
| ATSdynload (dummy) =>
  {
    // TODO: map to static constructor?
    val () = emit_text (out, "/* ATSdynload() */\n")
  }
//
| ATSdynloadset (flag) =>
  {
    val () = emit_text (out, "/* ATSdynloadset */\n")
    val () = emit_text (out, "ldc.i4.1")
    val () = emit_ENDL (out)
    val () = emit_text (out, "stsfld int32 ")
    val () = emit_text (out, the_clsname_get ())
    val () = emit_i0de (out, flag)
  }
//
| ATSdynloadflag_sta (flag) =>
  {
    val () = emit_text (out, "/* ATSdynloadflag_sta */\n")
  }
//
| ATSdynloadflag_ext (flag) =>
  {
    val () = emit_text (out, "/* ATSdynloadflag_ext */\n")
  }
//
| ATStailcalseq (inss) =>
  {
    val () = emit_text (out, "// ATStailcalseq_beg")
    val () = emit_ENDL (out)
    val () = emit_instrlst (out, inss, labthis, labnext, false)
    val () = emit_text (out, "// ATStailcalseq_end")
  } (* end of [ATStailcalseq] *)
//
| ATSINSmove_tlcal (tmp, d0e) =>
  {
    val () = emit_d0exp (out, d0e)
    val () = emit_ENDL (out)
    val () = emit_tmpvar_st (out, tmp)
  } (* end of [ATSINSmove_tlcal] *)
//
| ATSINSargmove_tlcal (tmp1, tmp2) =>
  {
    val () = emit_tmpvar_ld (out, tmp2)
    val () = emit_ENDL (out)
    val () = emit_tmpvar_st (out, tmp1)
  } (* end of [ATSINSargmove_tlcal] *)
//
| _ =>
  {
    val ((*error*)) = fprint! (out, "UNRECOGNIZED-INSTRUCTION: ", ins0)
  }
//
end // end of [emit_instr]

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

implement
emit_branchseqlst
  (out, inss, labthis, lablast) = let
//
fun auxseq
(
  out: FILEref
, ins0: instr
, labthis: label
, labnext: label
) : void = let
in
//
case-
ins0.instr_node of
//
| ATSbranchseq
    (inss) =>
  {
    val () = emit_text (out, "/* ATSbranch_beg */\n")
    val () = emit_instrlst (out, inss, labthis, labnext, true)
    val () = emit_text (out, "/* ATSbranch_end */\n")
  } // end of [ATSbranchseq]
//
end (* end of [auxseq] *)
//
fun auxseqlst
(
  out: FILEref
, inss: instrlst
, labnext: label
, lablast: label
) : void = let
in
//
case+ inss of
| list_nil () => ()
| list_cons
    (ins, inss) => let
//
    val labnext =
    (
      case+ inss of
      | list_nil () => lablast
      | _ => label_for_instrlst (inss)
    ) (* end of [val] *)
//
    val () = auxseq (out, ins, labnext, lablast)
//
    val () = emit_text (out, "br")
    val () = emit_SPACE (out)
    val () = emit_label (out, lablast)
    val () = emit_ENDL (out)
//
  in
    auxseqlst (out, inss, labnext, lablast)
  end (* end of [list_cons] *)
//
end (* end of [auxseqlst] *)
//
  val labthis =
  (
    case+ inss of
    | list_nil () => lablast
    | _ => label_for_instrlst (inss)
  ) (* end of [val] *)
//
in
  auxseqlst (out, inss, labthis, lablast);
end // end of [emit_branchseqlst]

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

implement
emit_instrlst
(
  out, inss, labthis, lablast, marklab
) = (
//
case+ inss of
| list_nil () => ()
| list_cons (ins0, inss) => let
  //
  //
  in
    case+ ins0.instr_node of
    | ATSINSlab (label) =>
      (
        emit_instrlst (out, inss, label, lablast, marklab)
      )
    | ATSINSflab (label) =>
      (
        emit_instrlst (out, inss, label, lablast, marklab)
      )
    | ATSlinepragma (line, file) =>
      {
        val () = emit_ENDL (out)
        val () = emit_text (out, ".line")
        val () = emit_SPACE (out)
        val-T_INT(_, lpos) = line.token_node
        val () = emit_text (out, lpos)
        val () = emit_SPACE (out)
        val-T_STRING(filnam) = file.token_node
        val filnam = g1ofg0 (filnam)
        // double quotes -> single quotes
        val () = emit_text (out, "'")
        // FIXME: very involved
        val-true = string_isnot_empty filnam
        val len = pred (length filnam)
        val-true = len > g1int2uint(0)
        val () = fprint_substring (out, filnam, g1int2uint(1), pred (len))
        val () = emit_text (out, "'")
        val () = emit_ENDL (out)
        val () = emit_instrlst (out, inss, labthis, lablast, marklab)
      }
    | _(*other*) =>
      {
        val () = (if marklab then emit_label_mark (out, labthis))
        val labnext =
        (
          case+ inss of
          | list_nil () => lablast
          | _ => label_for_instrlst (inss)
        ) (* end of [val] *)
        val () = emit_instr (out, ins0, labthis, labnext)
        val () = emit_ENDL (out)
        val () = emit_instrlst (out, inss, labnext, lablast, true(*mark the next instruction*))
      }
  end // end of [let]
//
) (* end of [emit_instrlst] *)

(* ****** ****** *)
//
extern
fun emit_ATSfunbodyseq
  (out: FILEref, ins: instr, labnext: label) : void
//
implement
emit_ATSfunbodyseq
  (out, ins, labnext) = let
//
val-ATSfunbodyseq (inss) = ins.instr_node
val L1 = label_for_instrlst (inss)
//
in
  emit_instrlst (out, inss, L1, labnext, true);
  emit_ENDL (out)
end // end of [emit_ATSfunbodyseq]

(* ****** ****** *)
//
extern
fun emit_f0body_0 : emit_type (f0body)
//
implement
emit_f0body_0
  (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 labnext = label_for_instrlst (inss1)
    val () = emit_ATSfunbodyseq (out, ins0, labnext)
    val () = emit_label_mark (out, labnext)
    val lablast =
    (
      case+ inss2 of
      | list_nil () => i0de_make_string (location_dummy, "LASTLABEL")
      | _ => label_for_instrlst (inss2)
    )
    val () = emit_instr (out, ins1, labnext, lablast)
  in
    auxlst (out, inss2)
  end // end of [list_cons]
) (* end of [auxlst] *)
//
in
//
case+
fbody.f0body_node of
//
| F0BODY (tds, inss) => let
    val () = label_reset ()
  in
    auxlst (out, inss)
  end // end of [auxlst]
//
end // end of [emit_f0body_0]

(* ****** ****** *)
implement
emit_f0body
  (out, fbody) = let
//
val tmpdecs =
  f0body_get_tmpdeclst (fbody)
//
val () = the_tmpdeclst_set (tmpdecs)
val () = emit_LBRACE (out)
val () = emit_newline (out)
// TODO: how to compute maxstack?
val () = emit_text (out, ".maxstack 16")
val () = emit_newline (out)
// emit locals
val () =
  case+ tmpdecs of
  | list_nil() => ()
  | _ => {
    val () = emit_text (out, ".locals")
    val () = emit_SPACE (out)
    (*
    val () = emit_text (out, "init")
    val () = emit_SPACE (out)
    *)
    val () = emit_LPAREN (out)
    val () = emit_newline (out)
    val () = emit_tmpdeclst (out, tmpdecs)
    val () = emit_RPAREN (out)
    val () = emit_newline (out)
  }
// end of [val]
val () = emit_f0body_0 (out, fbody)
val () = emit_newline (out)
val () = emit_RBRACE (out)
in
//
//
end // end of [emit_f0body]

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

implement
emit_f0decl
  (out, fdec) = let
in
//
case+
fdec.f0decl_node of
| F0DECLnone (fhd) =>
  // does this actually mean function declaration (e.g. forward function decl)?
  {
    val-F0HEAD(id, _, _) = fhd.f0head_node
    val () = f0head_insert (id.i0de_sym, fhd)
  }
| F0DECLsome (fhd, fbody) =>
  {
    val () = emit_text (out, ".method")
    val () = emit_SPACE (out)
    val () = emit_text (out, "static")
    // TODO: public/private?
    // static -> private
    val () = emit_SPACE (out)
    val () = emit_text (out, "public")
    val () = emit_SPACE (out)
    val-F0HEAD(id, _, _) = fhd.f0head_node
    val () = f0head_insert (id.i0de_sym, fhd)
    val () = emit_f0head (out, fhd, false)
    val () = emit_SPACE (out)
    val () = emit_text (out, "cil")
    val () = emit_SPACE (out)
    val () = emit_text (out, "managed")
    val () = emit_newline (out)
    val () = emit_f0body (out, fbody)
    val () = emit_newline (out)
  } (* end of [F0DECLsome] *)
//
end // end of [emit_f0decl]

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

//
extern
fun
tyrec_labsel
  (tyrec: tyrec, lab: symbol): int
//
implement
tyrec_labsel
  (tyrec, lab) = let
//
fun loop
(
  xs: tyfldlst, i: int
) : int =
(
case+ xs of
| list_cons (x, xs) => let
    val TYFLD (id, s0e) = x.tyfld_node
  in
    if lab = id.i0de_sym then i else loop (xs, i+1)
  end // end of [list_cons
| list_nil ((*void*)) => ~1(*error*)
)
//
in
  loop (tyrec.tyrec_node, 0)
end // end of [tyrec_labsel]
//
(* ****** ****** *)

implement
emit_SELcon
  (out, d0e) = let
//
val-ATSSELcon
  (d0rec, s0e, id) = d0e.d0exp_node
val-S0Eide (name) = s0e.s0exp_node
val-~Some_vt (s0rec) = typedef_search_opt (name)
//
val index = tyrec_labsel (s0rec, id.i0de_sym)
//
val () =
  emit_d0exp (out, d0rec)
//
val () = emit_LBRACKET (out)
val () = emit_int (out, index)
val () = emit_RBRACKET (out)
//
in
  // nothing
end // end of [emit_SELcon]

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

implement
emit_SELboxrec
  (out, d0e) = let
//
val-ATSSELboxrec
  (d0rec, s0e, id) = d0e.d0exp_node
val-S0Eide (name) = s0e.s0exp_node
val-~Some_vt (s0rec) = typedef_search_opt (name)
//
val index = tyrec_labsel (s0rec, id.i0de_sym)
//
val () =
  emit_d0exp (out, d0rec)
//
val () = emit_LBRACKET (out)
val () = emit_int (out, index)
val () = emit_RBRACKET (out)
//
in
  // nothing
end // end of [emit_SELboxrec]

(* ****** ****** *)
//
#define
ATSEXTCODE_BEG "/*\nATSextcode_beg()\n*/"
#define
ATSEXTCODE_END "/*\nATSextcode_end()\n*/"
//
(* ****** ****** *)
//
extern
fun
emit_d0eclist
(
  out: FILEref, d0cs: d0eclist
) : void
//
implement
emit_d0ecl
  (out, d0c) = let
in
//
case+
d0c.d0ecl_node of
//
| D0Cinclude include =>
  {
    val () = emit_text (out, "#include")
    val () = emit_SPACE (out)
    val () =
    (
      case- include.token_node of
      | T_STRING(filnam) => emit_text (out, filnam)
      | T_IDENT_alp(filnam) => emit_text (out, filnam)
    ) (* end of [val] *)
    val () = emit_newline (out)
  }
//
| D0Cifdef (i0de, d0eclist) =>
  {
    val () = emit_text (out, "#ifdef")
    val () = emit_SPACE (out)
    val () = emit_i0de (out, i0de)
    val () = emit_newline (out)

    val () = emit_d0eclist (out, d0eclist)

    val () = emit_text (out, "#endif")
    val () = emit_text (out, " /* end of [")
    val () = emit_i0de (out, i0de)
    val () = emit_text (out, "] */")
    val () = emit_newline (out)
  }
| D0Cifndef (i0de, d0eclist) =>
  {
    val () = emit_text (out, "#ifndef")
    val () = emit_SPACE (out)
    val () = emit_i0de (out, i0de)
    val () = emit_newline (out)
    val () = emit_text (out, "#endif")
    val () = emit_newline (out)
  }
//
| D0Ctypedef (id, def) =>
  {
    val () = typedef_insert (id.i0de_sym, def)
    (*
    val clsname = the_classname_get ()
    // map ATS external names to CIL names
    // - locally-defined (within a class in the current module)
    // - [AssemblyRef]NameSpace.Class::Method
    //   - namespace is a dotted name
    // - [AssemblyRef]NameSpace.Type
    // - [mscorlib]System.Void
    val () = qual_insert_local (id.i0de_sym, clsname)
    *)
  } (* end of [D0Ctypedef] *)
//
| D0Cassume (id) =>
  {
    val () = emit_text (out, "/* ATSassume(")
    val () = emit_i0de (out, id)
    val () = emit_text (out, ") */\n")
  }
//
| D0Cdyncst_mac ide =>
  // [ide] is the identifier for a dynamic constant which is implemented as a macro
  ()
  (*
  {
    val () = emit_text (out, "dyncst_mac")
    val () = emit_SPACE (out)
    val filnam = ide.i0de_sym
    val () = emit_symbol (out, filnam)
    val () = emit_ENDL (out)
  }*)
| D0Cdyncst_extfun (i0de, s0explst, s0exp) =>
  {
  }
//
| D0Cstatmp
    (tmp, opt) =>
  (
    case+ opt of
    | Some s0e =>
      (
        statmps0exp_insert (tmp.i0de_sym, s0e);
        emit_text (out, ".field static private ");
        emit_s0exp (out, s0e);
        emit_SPACE (out);
        emit_i0de (out, tmp);
        emit_ENDL (out)
      ) (* end of [Some] *)
    | None () =>
      (
        emit_text (out, "//");
        emit_text (out, ".field static void ");
        emit_i0de (out, tmp);
        emit_ENDL (out)
      ) (* end of [None] *)
  ) (* end of [D0Cstatmp] *)
//
| D0Cextcode (toks) =>
  {
    val () = emit_text (out, ATSEXTCODE_BEG)
    val () = emit_extcode (out, toks)
    val () = emit_text (out, ATSEXTCODE_END)
    val () = emit_ENDL (out)
  }
| D0Cclosurerize (_, _, _, _) => ()
//
| D0Cfundecl (fk, f0d) => emit_f0decl (out, f0d)
//
| D0Cdynloadflag_init (flag) =>
  (
    emit_text (out, "// dynloadflag_init\n");
    emit_text (out, ".field static int32 ");
    emit_i0de (out, flag);
    emit_ENDL (out)
  )
//
end // end of [emit_d0ecl]

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

implement
emit_d0eclist
(
  out, d0cs
) =
(
//
case+ d0cs of
| list_nil () => ()
| list_cons
    (d0c, d0cs) => let
  in
    emit_d0ecl (out, d0c); emit_d0eclist (out, d0cs)
  end // end of [list_cons]
//
) (* end of [emit_d0eclist] *)

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

implement
emit2_toplevel
  (out, d0cs, fname, namespace) = let
//
fun
loop0
(
  out: FILEref, d0cs: d0eclist
) : d0eclist =
(
case+ d0cs of
| list_nil () => d0cs
| list_cons
    (d0c, d0cs1) =>
  (
    case+
    d0c.d0ecl_node of
    | D0Cinclude _ => (emit_d0ecl (out, d0c); loop0 (out, d0cs1))
    | D0Cifdef _ => (emit_d0ecl (out, d0c); loop0 (out, d0cs1))
    | D0Cifndef _ => (emit_d0ecl (out, d0c); loop0 (out, d0cs1))
    | _ => d0cs
  ) // end of [list_cons]
)
//
// TODO: for the main file, emit assembly manifest (assembly references, etc.)
// TODO: for all modules, emit .module extern for other modules?
// TODO: handle entry point
//
//
fun{}
string_skip
{n,ofs:int | ofs >= 0; ofs <= n}
(str: string(n), ofs: size_t (ofs)): string = let
  prval () = lemma_string_param (str)
in
  if string_is_atend (str, ofs) then ""
  else if ofs > 0 then string_skip (string_tail (str), ofs-1)
  else g0ofg1(str)
end // end of [string_skip]
//
fun strip_suffix {n1,n2:int} (s: string (n1), suf: string (n2)): string = let
  val l1 = strlen(s)
  val l2 = strlen(suf)
  prval () = lemma_string_param (s) and () = lemma_string_param (suf)
in
  if l1 >= l2 then let
    val ofs = l1 - l2
    val s1 = string_skip (s, ofs)
  in
    if s1 <> suf then g0ofg1(s)
    else let
      val subs = string_make_substring (s, i2sz(0), ofs)
    in
      strnptr2string (subs)
    end // end of [let]
  end else g0ofg1(s)
end // end of [fun]
//
val clsname = strip_suffix (g1ofg0(fname), g1ofg0("_dats.c"))

val () = emit_text (out, ".assembly extern mscorlib { .ver 2:0:0:0 }\n")
val () = emit_text (out, ".assembly ")
val () = emit_text (out, clsname) // TODO: should it be the same as the output file name?
val () = emit_text (out, " { .ver 1:0:0:0 }")
val () = emit_ENDL (out)

val () = emit_text (out, ".module")
val () = emit_SPACE (out)
val () = emit_text (out, "'")
val () = emit_text (out, fname)
val () = emit_text (out, "'")
val () = emit_ENDL (out)
//
val d0cs = loop0 (out, d0cs) // all preprocessor definitions
//
val () = emit_text (out, ".namespace")
val () = emit_SPACE (out)
val () = emit_text (out, namespace)
val () = emit_SPACE (out)
val () = emit_LBRACE (out)
val () = emit_ENDL (out)
//
val () = the_clsname_push (namespace, clsname)
//
val () = emit_text (out, ".class")
val () = emit_SPACE (out)
val () = emit_text (out, clsname)
val () = emit_SPACE (out)
val () = emit_LBRACE (out)
val () = emit_ENDL (out)
val () = emit_d0eclist (out, d0cs)
val () = emit_RBRACE (out) (* end of [class] definition *)
val () = emit_text (out, "/* end of class */")
//
val () = emit_ENDL (out)
val () = emit_RBRACE (out) (* end of [namespace] definition *)
val () = emit_text (out, "/* end of namespace */")
val () = emit_ENDL (out)
//
val _ = the_clsname_pop ()
//
in
  (*empty*)
end // end of [emit2_toplevel]

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

(* end of [atsparemit_emit_cil.dats] *)

(* ****** ****** *)
//
// ATS-parse-emit-python
//
(* ****** ****** *)
//
// AS-2014-08-17: start
//
(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
staload "./atsparemit.sats"
staload "./atsparemit_cil.sats"
staload "./atsparemit_syntax.sats"
staload "./atsparemit_syntax_cil.sats"
//
(* ****** ****** *)
//
staload "./atsparemit_emit.sats"
//
(* ****** ****** *)
//
staload "./atsparemit_typedef.dats"
//
(* ****** ****** *)

implement
emit_ENDL (out) = emit_text (out, "\n")

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

implement
emit_SPACE (out) = emit_text (out, " ")

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

implement
emit_SHARP (out) = emit_text (out, "#")

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

implement
emit_COLON (out) = emit_text (out, ":")

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

implement
emit_LPAREN (out) = emit_text (out, "(")
implement
emit_RPAREN (out) = emit_text (out, ")")

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

implement
emit_LBRACE (out) = emit_text (out, "{")
implement
emit_RBRACE (out) = emit_text (out, "}")

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

implement
emit_LBRACKET (out) = emit_text (out, "[")
implement
emit_RBRACKET (out) = emit_text (out, "]")

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

implement
emit_flush (out) = fileref_flush (out)
implement
emit_newline (out) = fprint_newline (out)

(* ****** ****** *)
//
implement
emit_int (out, x) = fprint_int (out, x)
//
implement
emit_text (out, x) = fprint_string (out, x)
//
(* ****** ****** *)
//
implement
emit_symbol (out, x) =
  fprint_string (out, symbol_get_name (x))
//
(* ****** ****** *)

implement
emit_PMVint
  (out, tok) = let
//
val-T_INT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVint]

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

implement
emit_PMVi0nt
  (out, tok) = let
//
val-T_INT(base, rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVi0nt]

(* ****** ****** *)
//
implement
emit_PMVbool
  (out, tfv) =
(
  emit_text (out, if tfv then "1" else "0")
) (* end of [emit_PMVbool] *)
//
(* ****** ****** *)
implement
emit_PMVstring
  (out, tok) = let
//
val-T_STRING(rep) = tok.token_node
//
in
  emit_text (out, rep)
end // end of [emit_PMVstring]

(* ****** ****** *)
//
implement
emit_i0de
  (out, id) = emit_symbol (out, id.i0de_sym)
implement
emit_label
  (out, lab) = emit_symbol (out, lab.i0de_sym)
fun
emit_label_mark
  (out, lab) =
  {
    val () = emit_label (out, lab)
    val () = emit_COLON (out)
    val () = emit_ENDL (out)
  }
//
(* ****** ****** *)

implement
emit_extcode
  (out, toks) = let
//
fun
auxtok
(
  out: FILEref, tok: token
) : void =
(
case+
tok.token_node of
//
| T_KWORD _ => ()
//
| T_ENDL () => emit_ENDL (out)
| T_SPACES (cs) => emit_text (out, cs)
//
| T_COMMENT_line () =>
    emit_text (out, "// COMMENT_line\n")
| T_COMMENT_block () => ((*ignored*))
//
| T_INT (_, rep) => emit_text (out, rep)
//
| T_STRING (str) => emit_text (out, str)
//
| T_IDENT_alp (name) => emit_text (out, name)
| T_IDENT_srp (name) => emit_text (out, name) // FIXME?
//
| T_IDENT_sym (name) => emit_text (out, name)
//
| T_LPAREN () => emit_LPAREN (out)
| T_RPAREN () => emit_RPAREN (out)
//
| T_LBRACKET () => emit_LBRACKET (out)
| T_RBRACKET () => emit_RBRACKET (out)
//
| T_LBRACE () => emit_LBRACE (out)
| T_RBRACE () => emit_RBRACE (out)
//
| T_LT () => emit_text (out, "<")
| T_GT () => emit_text (out, ">")
//
| T_MINUS () => emit_text (out, "-")
//
| T_COLON () => emit_text (out, ":")
//
| T_COMMA () => emit_text (out, ",")
| T_SEMICOLON () => emit_text (out, ";")
//
| T_SLASH () => emit_text (out, "/")
//
| _ (*unrecognized*) =>
  {
    val () = fprint! (out, "TOKERR(", tok, ")")
  }
) (* end of [auxtok] *)
//
in
//
case+ toks of
| list_nil () => ()
| list_cons (tok, toks) =>
  (
    auxtok (out, tok); emit_extcode (out, toks)
  ) (* end of [list_cons] *)
//
end // end of [emit_extcode]

(* ****** ****** *)
//
extern
fun
emit_s0exp : emit_type (s0exp)
extern
fun
emit_s0explst : emit_type (s0explst)
//
extern
fun emit_tmpvar_ld (out: FILEref, tmp: i0de): void
//
extern
fun emit_tmpvar_st (out: FILEref, tmp: i0de): void
//
implement
  emit_tmpvar_ld (out, tmp) =
  {
    val () =
      case+ 0 of
      | _ when strstr(g1ofg0(symbol_get_name(tmp.i0de_sym)), "__dynloadflag") >= 0 =>
        {
          val () = emit_text (out, "ldsfld int32 ")
          val () = emit_text (out, the_clsname_get ())
        }
      | _ when tmpvar_is_sta (tmp.i0de_sym) =>
        {
          val () = emit_text (out, "ldsfld")
          val-~Some_vt(s0e) = statmps0exp_search_opt (tmp.i0de_sym)
          val () = emit_SPACE (out)
          val () = emit_s0exp (out, s0e)
          val () = emit_SPACE (out)
          val () = emit_text (out, the_clsname_get ())
        }
      | _ when tmpvar_is_arg (tmp.i0de_sym) =>
        {
          val () = emit_text (out, "ldarg")
        }
      | _ (*otherwise*) =>
        {
          val () =  emit_text (out, "ldloc")
        }
    // end of [val]
    val () = emit_SPACE (out)
    val () = emit_i0de (out, tmp)
  } // end of [emit_tmpvar_ld]
//
implement
  emit_tmpvar_st
    (out, tmp) =
  {
    val () =
      case+ 0 of
      | _ when strstr(g1ofg0(symbol_get_name(tmp.i0de_sym)), "__dynloadflag") >= 0 =>
        {
          val () = emit_text (out, "stsfld int32 ")
          val () = emit_text (out, the_clsname_get ())
          val () = println!("the_clsname_get() = ", the_clsname_get())
        }
      | _ when tmpvar_is_sta (tmp.i0de_sym) =>
        {
          val () = emit_text (out, "stsfld")
          val-~Some_vt(s0e) = statmps0exp_search_opt (tmp.i0de_sym)
          val () = emit_SPACE (out)
          val () = emit_s0exp (out, s0e)
          val () = emit_SPACE (out)
          val () = emit_text (out, the_clsname_get ())
        }
      | _ when tmpvar_is_arg (tmp.i0de_sym) =>
        {
          val () = emit_text (out, "starg")
        }
      | _(*otherwise*) =>
        {
          val () = emit_text (out, "stloc")
        }
    // end of [val]
    val () = emit_SPACE (out)
    val () = emit_i0de (out, tmp)
  } // end of [emit_tmpvar_st]
//
(* ****** ****** *)
//
extern
fun emit_MODCLSNAME (out: FILEref, fname: string): void
//
implement
  emit_MODCLSNAME (out, fname) = {
  val () = emit_text (out, "\'")
  // TODO: sanitize?
  val () = emit_text (out, fname)
  val () = emit_text (out, "\'")
} (* end of [emit_MODCLSNAME] *)
//
(* ****** ****** *)
//
extern
fun
emit_branchseqlst
  (out: FILEref, inss: instrlst, labthis: label, labnext: label): void
//
extern
fun
emit_instrlst
  (out: FILEref, inss: instrlst, labbeg: label, labend: label, marklab: bool) : void
//
(* ****** ****** *)
//
implement
emit_s0exp
  (out, s0e) = let
//
//
in
//
case+
s0e.s0exp_node of
//
| S0Eide (id) => emit_symbol (out, id)
| S0Elist (s0es) => () // shouldn't happen? marked as "temp"
| S0Eappid (id, s0es) =>
    // FIXME: what about other types? e.g. array types? struct types?
(
  case+ symbol_get_name (id.i0de_sym) of
  | "atstkind_t0ype" =>
    {
      // unboxed type, of sort t@ype in ATS
      val-list_cons (s0e, list_nil ()) = s0es
      val-S0Eide (id) = s0e.s0exp_node
      val () = emit_symbol (out, id)
    } (* end of [atstkind_t0ype] *)
  | _ =>
    {
      val () = emit_i0de (out, id)
      val () = emit_LPAREN (out)
      val () = emit_s0explst (out, s0es)
      val () = emit_RPAREN (out)
    } // end of [_]
)
//
end // end of [emit_s0exp]
//
(* ****** ****** *)

implement
emit_s0explst
  (out, s0es) = let
//
fun
loop
(
  out: FILEref, s0es: s0explst, i: int
) : void =
(
case+ s0es of
| list_nil () => ()
| list_cons (s0e, s0es) => let
    val () =
      if i > 0 then emit_text (out, ", ")
    // end of [val]
  in
    emit_s0exp (out, s0e); loop (out, s0es, i+1)
  end // end of [list_cons]
)
//
in
  loop (out, s0es, 0)
end // end of [emit_s0explst]

(* ****** ****** *)
//
extern
fun
funlab_get_index (fl: label): int
extern
fun
tmplab_get_index (lab: label): int
//
(* ****** ****** *)
//
extern
fun
the_f0arglst_get (): f0arglst
extern
fun
the_f0arglst_set (f0as: f0arglst): void
//
(* ****** ****** *)
//
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 (labs: labelist): void
//
(* ****** ****** *)
//
extern
fun
the_caseofseqlst_get (): instrlst
extern
fun
the_caseofseqlst_set (inss: instrlst): void
//
(* ****** ****** *)

local
//
val the_f0arglst = ref<f0arglst> (list_nil)
val the_tmpdeclst = ref<tmpdeclst> (list_nil)
//
val the_funbodylst = ref<instrlst> (list_nil)
//
val the_branchlablst = ref<labelist> (list_nil)
val the_caseofseqlst = ref<instrlst> (list_nil)
//
in (* in-of-local *)

implement
the_f0arglst_get () = !the_f0arglst
implement
the_f0arglst_set (xs) = !the_f0arglst := xs

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 () = !the_branchlablst
implement
the_branchlablst_set (xs) = !the_branchlablst := xs

implement
the_caseofseqlst_get () = !the_caseofseqlst
implement
the_caseofseqlst_set (xs) = !the_caseofseqlst := xs

end // end of [local]

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

local

fun
loop
(
  out: FILEref, d0es: d0explst, i: int
) : void =
(
case+ d0es of
| list_nil () => ()
| list_cons (d0e, d0es) => let
    val () =
      if i > 0 then emit_newline (out)
    // end of [val]
  in
    emit_d0exp (out, d0e);
    emit_newline (out);
    loop (out, d0es, i+1)
  end // end of [list_cons]
)

in (* in-of-local *)

implement
emit_d0explst (out, d0es) = loop (out, d0es, 0)
implement
emit_d0explst_1 (out, d0es) = loop (out, d0es, 1)

end // end of [local]

(* ******* ****** *)
//
extern
fun emit_f0arg : emit_type (f0arg)
extern
fun emit_f0marg : emit_type (f0marg)
extern
fun emit_f0head (out: FILEref, f0h: f0head, full: bool): void

//
(* ****** ****** *)

implement
emit_d0exp
  (out, d0e) = let
in
//
case+
d0e.d0exp_node of
//
| D0Eide (id) =>
  {
    val () = emit_tmpvar_ld (out, id)
  }
//
| D0Eappid (id, d0es) => let
    val () = emit_d0explst (out, d0es)

    // need type for [id]
    // what is [tyrec] type for?
    // val-~Some_vt (s0rec) = typedef_search_opt (id.i0de_sym)

    val f0head_opt = f0head_search_opt (id.i0de_sym)
  in
    case+ f0head_opt of
    | ~None_vt() =>
      {
        val () =
        (
          case+ symbol_get_name (id.i0de_sym) of
          //
          | "ATSCKnot" =>
            {
              val () = emit_text (out, "not")
            }
          | "ATSCKiseqz" =>
            {
              val () = emit_text (out, "ldc.i4.0")
              val () = emit_ENDL (out)
              val () = emit_text (out, "ceq")
            }
          | "ATSCKisneqz" =>
            {
              val () = emit_text (out, "ldc.i4.0")
              val () = emit_ENDL (out)
              val () = emit_text (out, "ceq")
              val () = emit_ENDL (out)
              val () = emit_text (out, "not")
            }
          (*
          // TODO:
          | "ATSCKptriscons"
          | "ATSCKptrisnull"
          *)
          // TODO: ATSCKpat_(con*|exn*)
          //
          | _ when strstr(g1ofg0(symbol_get_name(id.i0de_sym)), "__dynload") >= 0 =>
            {
              val () = emit_text (out, "call void ")
              val () = emit_text (out, the_clsname_get ())
              val () = emit_i0de (out, id)
              val () = emit_text (out, "()")
            } // end of [dynload]
          | _ =>
            {
              val () = emit_text (out, "call")
              val () = emit_SPACE (out)
              // leave the identifier as-is, to be resolved manually by the programmer
              val () = emit_i0de (out, id)
            }
        ) (* end of [val] *)
      }
    | ~Some_vt(fhd) =>
      {
        val () = emit_text (out, "call")
        val () = emit_SPACE (out)
        val () = emit_f0head (out, fhd, true)
      }
  end // end of [D0Eappid]
//
// TODO: D0Elist
//
| ATSempty (x) => emit_text (out, "ldnull")
//
| ATSPMVint (tok) =>
  {
    val () = emit_text (out, "ldc.i4")
    val () = emit_SPACE (out)
    val () = emit_PMVint (out, tok)
  } (* end of [ATSPMVint] *)
| ATSPMVi0nt (tok) =>
  {
    val-T_INT(base, rep) = tok.token_node
    val () = emit_text (out, "ldc.i4")
    val () = emit_SPACE (out)
    val () = emit_text (out, rep)
  } (* end of [ATSPMVi0nt] *)
//
| ATSPMVbool (tfv) =>
  {
    val () = emit_text (out, "ldc.i4")
    val () = emit_SPACE (out)
    val () = emit_PMVbool (out, tfv)
  } (* end of [ATSPMVbool] *)
//
| ATSPMVstring (tok) =>
  {
    val () = emit_text (out, "ldstr")
    val () = emit_SPACE(out)
    val () = emit_PMVstring (out, tok)
  } (* end of [ATSPMVstring] *)
//
| ATSPMVf0loat (tok) =>
  {
    val-T_FLOAT(base, rep) = tok.token_node
    val () = emit_text (out, "ldc.r4")
    val () = emit_SPACE (out)
    val () = emit_text (out, rep)
  }
//
| _ => emit_text (out, "**D0EXP**")
//
end // end of [emit_d0exp]

(* ****** ****** *)
//
extern
fun emit_f0body : emit_type (f0body)
//
(* ****** ****** *)

implement
emit_f0arg
  (out, f0a) = let
in
//
case+
f0a.f0arg_node of
//
| F0ARGnone s0e => emit_s0exp (out, s0e)
| F0ARGsome (id, s0e) =>
  {
    val () = emit_s0exp (out, s0e)
    val () = emit_SPACE (out)
    val () = emit_i0de (out, id)
  } (* end of [F0ARGsome] *)
//
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, full) = let
//
val f0as =
  f0head_get_f0arglst (fhd)
//
val () = the_f0arglst_set (f0as)
//
in
//
case+
fhd.f0head_node of
| F0HEAD
    (id(*name of function*), f0ma(*list of arguments*), res(*result type*)) =>
  {
    val () = emit_s0exp (out, res)
    val () = emit_SPACE (out)
    val () =
      if full then emit_text (out, the_clsname_get ())
    // end of [val]
    val () = emit_i0de (out, id)
    val () = emit_LPAREN (out)
    val () = emit_f0marg (out, f0ma)
    val () = emit_RPAREN (out)
  }
//
end // end of [emit_f0head]

(* ****** ****** *)
//
extern
fun
emit_tmpdeclst
  (out: FILEref, tds: tmpdeclst): void
//
implement
emit_tmpdeclst
  (out, tds) = let
//
fun auxlst
(
  out: FILEref, tds: tmpdeclst, i: int
) : void =
(
case+ tds of
| list_nil () => ()
| list_cons (td, tds) =>
  (
    case+ td.tmpdec_node of
    | TMPDECnone
        (tmp) => auxlst (out, tds, i) // probably ATStmpdec_void()
    | TMPDECsome
        (tmp, s0e) => let
        val () =
          if i > 0 then
            emit_text(out, ", ")
        // end of [val]
        val () = emit_s0exp (out, s0e)
        val () = emit_SPACE (out)
        val () = emit_i0de (out, tmp)
        val () = emit_newline (out)
      in
        auxlst (out, tds, i+1)
      end // end of [TMPDECsome]
  ) (* end of [list_cons] *)
)
//
in
  auxlst (out, tds, 0)
end // end of [emit_tmpdeclst_initize]
//
(* ****** ****** *)
//
extern
fun emit_instr_0
  (out: FILEref, ins: instr): void
//
implement
emit_instr_0
  (out, ins0) = let
in
//
case+
ins0.instr_node of
//
| ATSreturn (tmp) =>
  {
    val () = emit_tmpvar_ld (out, tmp)
    val () = emit_newline (out)
    val () = emit_text (out, "ret")
  }
//
| ATSreturn_void (tmp) =>
  {
    val () = emit_text (out, "ret")
  }
//
| _ => emit_text (out, "**INSTR**")
//
end // end of [emit_instr_0]
//
extern
fun emit_instr
  (out: FILEref, ins: instr, labthis: label, labnext: label) : void
//
implement
emit_instr
  (out, ins0, labthis, labnext) = let
in
//
case+
ins0.instr_node of
//
| ATSif
  (
    d0e(*test*), inss(*then*), inssopt(*else*)
  ) =>
  (
    emit_d0exp (out, d0e);
    emit_newline (out);

    case+ inssopt of
    | Some (inss2) =>
      {
        val () = emit_text (out, "brfalse")
        val () = emit_SPACE (out)
        val L1 = label_for_instrlst (inss2)
        val () = emit_label (out, L1)
        val () = emit_ENDL (out)
        val L0 = label_for_instrlst (inss)
        val brlab = make_label (ins0.instr_loc)
        val () = emit_instrlst (out, inss, L0, brlab, true)
        val () = emit_label_mark (out, brlab)
        val () = emit_text (out, "br")
        val () = emit_SPACE (out)
        val () = emit_label (out, labnext)
        val () = emit_ENDL (out)
        val () = emit_instrlst (out, inss2, L1, labnext, true)
      }
    | None () =>
      {
        val () = emit_text (out, "brfalse")
        val () = emit_SPACE (out)
        val () = emit_label (out, labnext)
        val () = emit_ENDL (out)
        val brlab = make_label (ins0.instr_loc)
        val () = emit_instrlst (out, inss, brlab, labnext, true)
      }
  )
//
| ATSifthen (d0e, inss) =>
  {
//
    val-list_cons (ins, _) = inss
//
    val () = emit_d0exp (out, d0e)
    val () = emit_ENDL (out)
    val () = emit_text (out, "brfalse")
    val () = emit_SPACE (out)
    val () = emit_label (out, labnext)
    val () = emit_ENDL (out)
    val brlab = make_label (ins.instr_loc)
    val () = emit_instr (out, ins, brlab, labnext)
  }
| ATSifnthen (d0e, inss) =>
  {
//
    val-list_cons (ins, _) = inss
//
    val () = emit_d0exp (out, d0e)
    val () = emit_ENDL (out)
    val () = emit_text (out, "brtrue")
    val () = emit_SPACE (out)
    val () = emit_label (out, labnext)
    val () = emit_ENDL (out)
    val brlab = make_label (ins.instr_loc)
    val () = emit_instr (out, ins, brlab, labnext)
  }
//
| ATSbranchseq (inss) =>
  {
    val () = emit_text (out, "/* ATSbranch */")
  }
//
| ATScaseofseq (inss) =>
  {
    val () = emit_text (out, "/* ATScaseofseq_beg */\n")
    val () = emit_branchseqlst (out, inss, labthis, labnext)
    val () = emit_text (out, "/* ATScaseofseq_end */\n")
  }
//
// TODO: ATSlinepragma
//
| ATSreturn (tmp) =>
  {
    val () =
      if tmpvar_is_arg (tmp.i0de_sym)
        then emit_text (out, "ldarg")
        else emit_text (out, "ldloc")
    // end of [val]
    val () = emit_SPACE (out)
    val () = emit_i0de (out, tmp)
    val () = emit_newline (out)
    val () = emit_text (out, "ret")
  }
//
| ATSreturn_void (tmp) =>
  {
    val () = emit_text (out, "ret")
  }
//
(*
| ATSlinepragma (line, file) =>
  {
    val () = emit_text (out, ".line")
    val () = emit_SPACE (out)
    val-T_INT(_, lpos) = line.token_node
    val () = emit_text (out, lpos)
    val () = emit_SPACE (out)
    val-T_STRING(filnam) = file.token_node
    val () = emit_text (out, filnam)
  }
*)
//
(*
| ATSINSlab (lab) =>
  {
    val () = emit_label_mark (out, lab)
  }
*)
//
| ATSINSgoto (lab) =>
  {
    val () = emit_text (out, "br")
    val () = emit_SPACE (out)
    val () = emit_label (out, lab)
  }
//
(*
| ATSINSflab (flab) =>
  {
    val () = emit_label_mark (out, flab)
  }
*)
//
| ATSINSfgoto (flab) =>
  {
    val () = emit_text (out, "br")
    val () = emit_SPACE (out)
    val () = emit_label (out, flab)
  }
//
| ATSINSmove (tmp, d0e) =>
  {
    val () = emit_d0exp (out, d0e)
    val () = emit_newline (out)
    val () = emit_tmpvar_st (out, tmp)
  } (* end of [ATSINSmove] *)
| ATSINSmove_void (_, d0e) =>
  {
    val () = emit_d0exp (out, d0e)
  } (* end of [ATSINSmove_void] *)
//
| ATSdynload (dummy) =>
  {
    // TODO: map to static constructor?
    val () = emit_text (out, "/* ATSdynload() */\n")
  }
//
| ATSdynloadset (flag) =>
  {
    val () = emit_text (out, "/* ATSdynloadset */\n")
    val () = emit_text (out, "ldc.i4.1")
    val () = emit_ENDL (out)
    val () = emit_text (out, "stsfld int32 ")
    val () = emit_text (out, the_clsname_get ())
    val () = emit_i0de (out, flag)
  }
//
| ATSdynloadflag_sta (flag) =>
  {
    val () = emit_text (out, "/* ATSdynloadflag_sta */\n")
  }
//
| ATSdynloadflag_ext (flag) =>
  {
    val () = emit_text (out, "/* ATSdynloadflag_ext */\n")
  }
//
| ATStailcalseq (inss) =>
  {
    val () = emit_text (out, "// ATStailcalseq_beg")
    val () = emit_ENDL (out)
    val () = emit_instrlst (out, inss, labthis, labnext, false)
    val () = emit_text (out, "// ATStailcalseq_end")
  } (* end of [ATStailcalseq] *)
//
| ATSINSmove_tlcal (tmp, d0e) =>
  {
    val () = emit_d0exp (out, d0e)
    val () = emit_ENDL (out)
    val () = emit_tmpvar_st (out, tmp)
  } (* end of [ATSINSmove_tlcal] *)
//
| ATSINSargmove_tlcal (tmp1, tmp2) =>
  {
    val () = emit_tmpvar_ld (out, tmp2)
    val () = emit_ENDL (out)
    val () = emit_tmpvar_st (out, tmp1)
  } (* end of [ATSINSargmove_tlcal] *)
//
| _ =>
  {
    val ((*error*)) = fprint! (out, "UNRECOGNIZED-INSTRUCTION: ", ins0)
  }
//
end // end of [emit_instr]

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

implement
emit_branchseqlst
  (out, inss, labthis, lablast) = let
//
fun auxseq
(
  out: FILEref
, ins0: instr
, labthis: label
, labnext: label
) : void = let
in
//
case-
ins0.instr_node of
//
| ATSbranchseq
    (inss) =>
  {
    val () = emit_text (out, "/* ATSbranch_beg */\n")
    val () = emit_instrlst (out, inss, labthis, labnext, true)
    val () = emit_text (out, "/* ATSbranch_end */\n")
  } // end of [ATSbranchseq]
//
end (* end of [auxseq] *)
//
fun auxseqlst
(
  out: FILEref
, inss: instrlst
, labnext: label
, lablast: label
) : void = let
in
//
case+ inss of
| list_nil () => ()
| list_cons
    (ins, inss) => let
//
    val labnext =
    (
      case+ inss of
      | list_nil () => lablast
      | _ => label_for_instrlst (inss)
    ) (* end of [val] *)
//
    val () = auxseq (out, ins, labnext, lablast)
//
    val () = emit_text (out, "br")
    val () = emit_SPACE (out)
    val () = emit_label (out, lablast)
    val () = emit_ENDL (out)
//
  in
    auxseqlst (out, inss, labnext, lablast)
  end (* end of [list_cons] *)
//
end (* end of [auxseqlst] *)
//
  val labthis =
  (
    case+ inss of
    | list_nil () => lablast
    | _ => label_for_instrlst (inss)
  ) (* end of [val] *)
//
in
  auxseqlst (out, inss, labthis, lablast);
end // end of [emit_branchseqlst]

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

implement
emit_instrlst
(
  out, inss, labthis, lablast, marklab
) = (
//
case+ inss of
| list_nil () => ()
| list_cons (ins0, inss) => let
  //
  //
  in
    case+ ins0.instr_node of
    | ATSINSlab (label) =>
      (
        emit_instrlst (out, inss, label, lablast, marklab)
      )
    | ATSINSflab (label) =>
      (
        emit_instrlst (out, inss, label, lablast, marklab)
      )
    | ATSlinepragma (line, file) =>
      {
        val () = emit_ENDL (out)
        val () = emit_text (out, ".line")
        val () = emit_SPACE (out)
        val-T_INT(_, lpos) = line.token_node
        val () = emit_text (out, lpos)
        val () = emit_SPACE (out)
        val-T_STRING(filnam) = file.token_node
        val filnam = g1ofg0 (filnam)
        // double quotes -> single quotes
        val () = emit_text (out, "'")
        // FIXME: very involved
        val-true = string_isnot_empty filnam
        val len = pred (length filnam)
        val-true = len > g1int2uint(0)
        val () = fprint_substring (out, filnam, g1int2uint(1), pred (len))
        val () = emit_text (out, "'")
        val () = emit_ENDL (out)
        val () = emit_instrlst (out, inss, labthis, lablast, marklab)
      }
    | _(*other*) =>
      {
        val () = (if marklab then emit_label_mark (out, labthis))
        val labnext =
        (
          case+ inss of
          | list_nil () => lablast
          | _ => label_for_instrlst (inss)
        ) (* end of [val] *)
        val () = emit_instr (out, ins0, labthis, labnext)
        val () = emit_ENDL (out)
        val () = emit_instrlst (out, inss, labnext, lablast, true(*mark the next instruction*))
      }
  end // end of [let]
//
) (* end of [emit_instrlst] *)

(* ****** ****** *)
//
extern
fun emit_ATSfunbodyseq
  (out: FILEref, ins: instr, labnext: label) : void
//
implement
emit_ATSfunbodyseq
  (out, ins, labnext) = let
//
val-ATSfunbodyseq (inss) = ins.instr_node
val L1 = label_for_instrlst (inss)
//
in
  emit_instrlst (out, inss, L1, labnext, true);
  emit_ENDL (out)
end // end of [emit_ATSfunbodyseq]

(* ****** ****** *)
//
extern
fun emit_f0body_0 : emit_type (f0body)
//
implement
emit_f0body_0
  (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 labnext = label_for_instrlst (inss1)
    val () = emit_ATSfunbodyseq (out, ins0, labnext)
    val () = emit_label_mark (out, labnext)
    val lablast =
    (
      case+ inss2 of
      | list_nil () => i0de_make_string (location_dummy, "LASTLABEL")
      | _ => label_for_instrlst (inss2)
    )
    val () = emit_instr (out, ins1, labnext, lablast)
  in
    auxlst (out, inss2)
  end // end of [list_cons]
) (* end of [auxlst] *)
//
in
//
case+
fbody.f0body_node of
//
| F0BODY (tds, inss) => let
    val () = label_reset ()
  in
    auxlst (out, inss)
  end // end of [auxlst]
//
end // end of [emit_f0body_0]

(* ****** ****** *)
implement
emit_f0body
  (out, fbody) = let
//
val tmpdecs =
  f0body_get_tmpdeclst (fbody)
//
val () = the_tmpdeclst_set (tmpdecs)
val () = emit_LBRACE (out)
val () = emit_newline (out)
// TODO: how to compute maxstack?
val () = emit_text (out, ".maxstack 16")
val () = emit_newline (out)
// emit locals
val () =
  case+ tmpdecs of
  | list_nil() => ()
  | _ => {
    val () = emit_text (out, ".locals")
    val () = emit_SPACE (out)
    (*
    val () = emit_text (out, "init")
    val () = emit_SPACE (out)
    *)
    val () = emit_LPAREN (out)
    val () = emit_newline (out)
    val () = emit_tmpdeclst (out, tmpdecs)
    val () = emit_RPAREN (out)
    val () = emit_newline (out)
  }
// end of [val]
val () = emit_f0body_0 (out, fbody)
val () = emit_newline (out)
val () = emit_RBRACE (out)
in
//
//
end // end of [emit_f0body]

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

implement
emit_f0decl
  (out, fdec) = let
in
//
case+
fdec.f0decl_node of
| F0DECLnone (fhd) =>
  // does this actually mean function declaration (e.g. forward function decl)?
  {
    val-F0HEAD(id, _, _) = fhd.f0head_node
    val () = f0head_insert (id.i0de_sym, fhd)
  }
| F0DECLsome (fhd, fbody) =>
  {
    val () = emit_text (out, ".method")
    val () = emit_SPACE (out)
    val () = emit_text (out, "static")
    // TODO: public/private?
    // static -> private
    val () = emit_SPACE (out)
    val () = emit_text (out, "public")
    val () = emit_SPACE (out)
    val-F0HEAD(id, _, _) = fhd.f0head_node
    val () = f0head_insert (id.i0de_sym, fhd)
    val () = emit_f0head (out, fhd, false)
    val () = emit_SPACE (out)
    val () = emit_text (out, "cil")
    val () = emit_SPACE (out)
    val () = emit_text (out, "managed")
    val () = emit_newline (out)
    val () = emit_f0body (out, fbody)
    val () = emit_newline (out)
  } (* end of [F0DECLsome] *)
//
end // end of [emit_f0decl]

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

//
extern
fun
tyrec_labsel
  (tyrec: tyrec, lab: symbol): int
//
implement
tyrec_labsel
  (tyrec, lab) = let
//
fun loop
(
  xs: tyfldlst, i: int
) : int =
(
case+ xs of
| list_cons (x, xs) => let
    val TYFLD (id, s0e) = x.tyfld_node
  in
    if lab = id.i0de_sym then i else loop (xs, i+1)
  end // end of [list_cons
| list_nil ((*void*)) => ~1(*error*)
)
//
in
  loop (tyrec.tyrec_node, 0)
end // end of [tyrec_labsel]
//
(* ****** ****** *)

implement
emit_SELcon
  (out, d0e) = let
//
val-ATSSELcon
  (d0rec, s0e, id) = d0e.d0exp_node
val-S0Eide (name) = s0e.s0exp_node
val-~Some_vt (s0rec) = typedef_search_opt (name)
//
val index = tyrec_labsel (s0rec, id.i0de_sym)
//
val () =
  emit_d0exp (out, d0rec)
//
val () = emit_LBRACKET (out)
val () = emit_int (out, index)
val () = emit_RBRACKET (out)
//
in
  // nothing
end // end of [emit_SELcon]

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

implement
emit_SELboxrec
  (out, d0e) = let
//
val-ATSSELboxrec
  (d0rec, s0e, id) = d0e.d0exp_node
val-S0Eide (name) = s0e.s0exp_node
val-~Some_vt (s0rec) = typedef_search_opt (name)
//
val index = tyrec_labsel (s0rec, id.i0de_sym)
//
val () =
  emit_d0exp (out, d0rec)
//
val () = emit_LBRACKET (out)
val () = emit_int (out, index)
val () = emit_RBRACKET (out)
//
in
  // nothing
end // end of [emit_SELboxrec]

(* ****** ****** *)
//
#define
ATSEXTCODE_BEG "/*\nATSextcode_beg()\n*/"
#define
ATSEXTCODE_END "/*\nATSextcode_end()\n*/"
//
(* ****** ****** *)

implement
emit_d0ecl
  (out, d0c) = let
in
//
case+
d0c.d0ecl_node of
//
| D0Cinclude include =>
  {
    val () = emit_text (out, "#include")
    val () = emit_SPACE (out)
    val-T_STRING(filnam) = include.token_node
    val () = emit_text (out, filnam)
    val () = emit_newline (out)
  }
//
| D0Cifdef (i0de, d0eclist) =>
  {
    val () = emit_text (out, "#ifdef")
    val () = emit_SPACE (out)
    val () = emit_i0de (out, i0de)
    val () = emit_newline (out)
    val () = emit_text (out, "#endif")
    val () = emit_newline (out)
  }
| D0Cifndef (i0de, d0eclist) =>
  {
    val () = emit_text (out, "#ifndef")
    val () = emit_SPACE (out)
    val () = emit_i0de (out, i0de)
    val () = emit_newline (out)
    val () = emit_text (out, "#endif")
    val () = emit_newline (out)
  }
//
| D0Ctypedef (id, def) =>
  {
    val () = typedef_insert (id.i0de_sym, def)
    (*
    val clsname = the_classname_get ()
    // map ATS external names to CIL names
    // - locally-defined (within a class in the current module)
    // - [AssemblyRef]NameSpace.Class::Method
    //   - namespace is a dotted name
    // - [AssemblyRef]NameSpace.Type
    // - [mscorlib]System.Void
    val () = qual_insert_local (id.i0de_sym, clsname)
    *)
  } (* end of [D0Ctypedef] *)
//
| D0Cassume (id) =>
  {
    val () = emit_text (out, "/* ATSassume(")
    val () = emit_i0de (out, id)
    val () = emit_text (out, ") */\n")
  }
//
| D0Cdyncst_mac ide =>
  // [ide] is the identifier for a dynamic constant which is implemented as a macro
  ()
  (*
  {
    val () = emit_text (out, "dyncst_mac")
    val () = emit_SPACE (out)
    val filnam = ide.i0de_sym
    val () = emit_symbol (out, filnam)
    val () = emit_ENDL (out)
  }*)
| D0Cdyncst_extfun (i0de, s0explst, s0exp) =>
  {
  }
//
| D0Cstatmp
    (tmp, opt) =>
  (
    case+ opt of
    | Some s0e =>
      (
        statmps0exp_insert (tmp.i0de_sym, s0e);
        emit_text (out, ".field static private ");
        emit_s0exp (out, s0e);
        emit_SPACE (out);
        emit_i0de (out, tmp);
        emit_ENDL (out)
      ) (* end of [Some] *)
    | None () =>
      (
        emit_text (out, "//");
        emit_text (out, ".field static void ");
        emit_i0de (out, tmp);
        emit_ENDL (out)
      ) (* end of [None] *)
  ) (* end of [D0Cstatmp] *)
//
| D0Cextcode (toks) =>
  {
    val () = emit_text (out, ATSEXTCODE_BEG)
    val () = emit_extcode (out, toks)
    val () = emit_text (out, ATSEXTCODE_END)
  }
| D0Cclosurerize (_, _, _, _) => ()
//
| D0Cfundecl (fk, f0d) => emit_f0decl (out, f0d)
//
| D0Cdynloadflag_init (flag) =>
  (
    emit_text (out, "// dynloadflag_init\n");
    emit_text (out, ".field static int32 ");
    emit_i0de (out, flag);
    emit_ENDL (out)
  )
//
end // end of [emit_d0ecl]

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

implement
emit2_toplevel
  (out, d0cs, fname, namespace) = let
//
fun
loop
(
  out: FILEref, d0cs: d0eclist
) : void =
(
//
case+ d0cs of
| list_nil () => ()
| list_cons
    (d0c, d0cs) => let
  in
    emit_d0ecl (out, d0c); loop (out, d0cs)
  end // end of [list_cons]
//
)
//
// TODO: for the main file, emit assembly manifest (assembly references, etc.)
// TODO: for all modules, emit .module extern for other modules?
// TODO: handle entry point
//
//
fun{}
string_skip
{n,ofs:int | ofs >= 0; ofs <= n}
(str: string(n), ofs: size_t (ofs)): string = let
  prval () = lemma_string_param (str)
in
  if string_is_atend (str, ofs) then ""
  else if ofs > 0 then string_skip (string_tail (str), ofs-1)
  else g0ofg1(str)
end // end of [string_skip]
//
fun strip_suffix {n1,n2:int} (s: string (n1), suf: string (n2)): string = let
  val l1 = strlen(s)
  val l2 = strlen(suf)
  prval () = lemma_string_param (s) and () = lemma_string_param (suf)
in
  if l1 >= l2 then let
    val ofs = l1 - l2
    val s1 = string_skip (s, ofs)
  in
    if s1 <> suf then g0ofg1(s)
    else let
      val subs = string_make_substring (s, i2sz(0), ofs)
    in
      strnptr2string (subs)
    end // end of [let]
  end else g0ofg1(s)
end // end of [fun]
//
val clsname = strip_suffix (g1ofg0(fname), g1ofg0("_dats.c"))

val () = emit_text (out, ".assembly extern mscorlib { .ver 2:0:0:0 }\n")
val () = emit_text (out, ".assembly ")
val () = emit_text (out, clsname)
val () = emit_text (out, " { .ver 1:0:0:0 }")
val () = emit_ENDL (out)

val () = emit_text (out, ".module")
val () = emit_SPACE (out)
val () = emit_text (out, "'")
val () = emit_text (out, fname)
val () = emit_text (out, "'")
val () = emit_ENDL (out)
//
val () = emit_text (out, ".namespace")
val () = emit_SPACE (out)
val () = emit_text (out, namespace)
val () = emit_SPACE (out)
val () = emit_LBRACE (out)
val () = emit_ENDL (out)
//
val () = the_clsname_push (namespace, clsname)
//
val () = emit_text (out, ".class")
val () = emit_SPACE (out)
val () = emit_text (out, clsname)
val () = emit_SPACE (out)
val () = emit_LBRACE (out)
val () = emit_ENDL (out)
val () = loop (out, d0cs)
val () = emit_RBRACE (out) (* end of [class] definition *)
val () = emit_text (out, "/* end of class */")
//
val () = emit_ENDL (out)
val () = emit_RBRACE (out) (* end of [namespace] definition *)
val () = emit_text (out, "/* end of namespace */")
//
val _ = the_clsname_pop ()
//
in
  (*empty*)
end // end of [emit2_toplevel]

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

(* end of [atsparemit_emit_cil.dats] *)


Updating: very minorly improving

Updating: very minorly improving

(*
** Channel pairs
*)

(* ****** ****** *)
//
staload
"./../SATS/basis.sats"
staload
"./../SATS/intset.sats"
//
staload "./basis_uchan.dats"
//
(* ****** ****** *)
//
absvtype
channel0_vtype(a:vt@ype, n:int)
//
stadef channel0 = channel0_vtype
//
extern
praxi
lemma_channel0_param
  {a:vt0p}{n:int}
  (chan0: !channel0(a, n)): [n >= 0] void
//
(* ****** ****** *)
//
extern
fun
{a:vt0p}
channel0_posneg
  {n:nat}
(
  cap: intGt(0)
, nrole: int(n), G: intset(n)
) :
(
  channel0(a, n)(*pos*), channel0(a, n)(*neg*)
) (* end of [channel0_posneg] *)
//
(* ****** ****** *)
//
extern
fun
{a:vt0p}
channel0_free
  {n:int}(chan0: channel0(a, n)): void
//
(* ****** ****** *)
//
extern
fun{a:vt0p}
channel0_send
  {n:int}
(
  !channel0(a, n)
, i: natLt(n), j: natLt(n), x: a
) : void // end-of-function
//
extern
fun{a:vt0p}
channel0_recv
  {n:int}
(
  !channel0(a, n)
, i: natLt(n), j: natLt(n), x: &a? >> a
) : void // end-of-function
extern
fun{a:vt0p}
channel0_recv_val
  {n:int}
(
  !channel0(a, n), i: natLt(n), j: natLt(n)
) : (a) // end of [channel0_recv_val]
//
(* ****** ****** *)
//
extern
fun
{a:vt0p}
channel0_link
  {n:int}
(
  cap: intGt(0)
, chan0: channel0(a, n), chan1: channel0(a, n)
) : channel0(a, n)
//
extern
fun
{a:vt0p}
cchannel0_link
  {n:int}
(
  cap: intGt(0)
, chan0: channel0(a, n), chan1: channel0(a, n)
) : channel0(a, n)
//
(* ****** ****** *)
//
datavtype
channel0_
(
  a:vt@ype, n:int
) =
CHANNEL0 of
(
  int(n), intset(n)
, matrixptr(uchan(a), n, n)
) (* end of [channel0_] *)
//
(* ****** ****** *)
//
assume
channel0_vtype
  (a:vt0p, n:int) = channel0_(a, n)
//
(* ****** ****** *)

implement
{a}(*tmp*)
channel0_posneg
  {n}(cap, nrole, G0) = let
//
val G1 =
  intset_ncomplement(G0, nrole)
//
val nrow = i2sz(nrole)
val ncol = i2sz(nrole)
//
vtypedef uchan = uchan(a)
//
val
u0ch = the_null_ptr
val
chmat0 =
matrixptr_make_elt<ptr>(nrow, ncol, u0ch)
val
chmat1 =
matrixptr_make_elt<ptr>(nrow, ncol, u0ch)
//
val
chmat0 =
$UN.castvwtp0{matrixptr(uchan,n,n)}(chmat0)
val
chmat1 =
$UN.castvwtp0{matrixptr(uchan,n,n)}(chmat1)
//
val p0 = ptrcast(chmat0)
and p1 = ptrcast(chmat1)
//
var
fwork =
lam@
( i: natLt(n)
, j: natLt(n)
) : void =>
{
  val n = nrole
  val chx0 = uchan_make(cap)
  and chy0 = uchan_make(cap)
  val chx1 = uchan_ref(chx0)
  and chy1 = uchan_ref(chy0)
  val ij = i * n + j and ji = j * n + i
  val () = $UN.ptr0_set_at<uchan>(p0, ij, chx0)
  val () = $UN.ptr0_set_at<uchan>(p0, ji, chy0)
  val () = $UN.ptr0_set_at<uchan>(p1, ij, chx1)
  val () = $UN.ptr0_set_at<uchan>(p1, ji, chy1)
} (* end of [fwork] *)
//
val () =
  intset2_foreach_cloref(G0, G1, $UN.cast(addr@fwork))
//
in
  (CHANNEL0(nrole, G0, chmat0), CHANNEL0(nrole, G1, chmat1))
end // end of [channel0_posneg]

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

implement
{a}(*tmp*)
channel0_free
  (chan0) = let
//
val () =
lemma_channel0_param(chan0)
//
val
~CHANNEL0(n, G, chmat) = chan0
//
implement
(elt:vtype)
matrix_uninitize$clear<elt>
  (i, j, x) = let
//
val x = $UN.castvwtp0{ptr}(x)
//
in
//
if
isneqz(x)
then (
  uchan_unref($UN.castvwtp0{uchan(a)}(x))
) (* end of [if] *)
//
end // end of [matrix_uninitize$clear]
//
val n = i2sz(n)
//
val () = matrixptr_freelin(chmat, n, n)
//
in
  // nothing
end // end of [channel0_free]

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

implement
{a}(*tmp*)
channel0_send
  (chan0, i, j, x0) =
{
//
val+CHANNEL0(n, G, chmat) = chan0
//
val p0 = ptrcast(chmat)
//
val uch =
  $UN.ptr0_get_at<uchan(a)>(p0, i*n+j)
//
val ((*void*)) = uchan_insert<a> (uch, x0)
//
val ((*returned*)) = $UN.cast2void(uch)
//
} (* end of [channel0_send] *)

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

implement
{a}(*tmp*)
channel0_recv
  (chan0, i, j, x0) = let
//
val+CHANNEL0(n, G, chmat) = chan0
//
val p0 = ptrcast(chmat)
//
val p_ij =
  ptr_add<uchan(a)>(p0, i*n+j)
//
val (pf, fpf | p_ij) =
  $UN.ptr_vtake{uchan(a)}(p_ij)
//
val () = (x0 := uchan_remove<a> (!p_ij))
//
prval ((*returned*)) = fpf(pf)
//
in
  // nothing
end // end of [channel0_recv]

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

implement
{a}(*tmp*)
channel0_recv_val
  (chan0, i, j) = x0 where
{
//
var x0: a // uninitized
//
val () = channel0_recv(chan0, i, j, x0)
//
} (* end of [channel0_recv_val] *)

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

implement
{a}(*tmp*)
channel0_link
  (cap, chan0, chan1) = let
//
prval() =
  lemma_channel0_param(chan0)
prval() =
  lemma_channel0_param(chan1)
//
fun
auxlink{n:nat}
(
  n: int(n)
, G0: intset(n), G1: intset(n), p0: ptr, p1: ptr
) : void =
{
//
vtypedef
uchan = uchan(a)
//
var
fwork =
lam@
( i: natLt(n)
, j: natLt(n)
) : void =>
{
//
  val ij = i * n + j
  val ch0_ij =
    $UN.ptr0_get_at<uchan>(p0, ij)
  val ch1_ij =
    $UN.ptr0_get_at<uchan>(p1, ij)
  val () = uchan_qinsert(ch0_ij, ch1_ij)
  val ((*freed*)) = uchan_unref(ch0_ij)
//
  val ji = j * n + i
  val ch0_ji =
    $UN.ptr0_get_at<uchan>(p0, ji)
  val ch1_ji =
    $UN.ptr0_get_at<uchan>(p1, ji)
  val () = uchan_qinsert(ch1_ji, ch0_ji)
  val ((*freed*)) = uchan_unref(ch1_ji)
//
} (* end of [fwork] *)
//
val () = intset2_foreach_cloref(G0, G1, $UN.cast(addr@fwork))
//
} (* end of [auxlink] *)
//
val+
~CHANNEL0(n0, G0, chmat0) = chan0
val+
~CHANNEL0(n1, G1, chmat1) = chan1
//
val G2 = intset_union(G0, G1) // HX: G0*G1 = 0
//
val (chan2, chan2_) = channel0_posneg(cap, n0, G2)
//
val+~CHANNEL0(_, G2_, chmat2_) = chan2_
//
val p0 = ptrcast(chmat0)
val p1 = ptrcast(chmat1)
val p2_ = ptrcast(chmat2_)
//
val () = auxlink(n0, G0, G1, p0, p1)
val () = auxlink(n0, G0, G2_, p0, p2_)
val () = auxlink(n1, G1, G2_, p1, p2_)
//
val chmat0 =
$UN.castvwtp0{matrixptr(ptr,0,0)}(chmat0)
val chmat1 =
$UN.castvwtp0{matrixptr(ptr,0,0)}(chmat1)
val chmat2_ =
$UN.castvwtp0{matrixptr(ptr,0,0)}(chmat2_)
//
val ((*freed*)) = matrixptr_free(chmat0)
val ((*freed*)) = matrixptr_free(chmat1)
val ((*freed*)) = matrixptr_free(chmat2_)
//
in
  chan2
end // end of [channel0_link]

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

implement
{a}(*tmp*)
cchannel0_link
  (cap, chan0, chan1) = let
//
prval() =
  lemma_channel0_param(chan0)
prval() =
  lemma_channel0_param(chan1)
//
fun
auxlink{n:nat}
(
  n: int(n)
, G0: intset(n), G1: intset(n), p0: ptr, p1: ptr
) : void =
{
//
vtypedef
uchan = uchan(a)
//
var
fwork =
lam@
( i: natLt(n)
, j: natLt(n)
) : void =>
{
//
  val ij = i * n + j
  val ch0_ij =
    $UN.ptr0_get_at<uchan>(p0, ij)
  val ch1_ij =
    $UN.ptr0_get_at<uchan>(p1, ij)
  val () = uchan_qinsert(ch0_ij, ch1_ij)
  val ((*freed*)) = uchan_unref(ch0_ij)
//
  val ji = j * n + i
  val ch0_ji =
    $UN.ptr0_get_at<uchan>(p0, ji)
  val ch1_ji =
    $UN.ptr0_get_at<uchan>(p1, ji)
  val () = uchan_qinsert(ch1_ji, ch0_ji)
  val ((*freed*)) = uchan_unref(ch1_ji)
//
} (* end of [fwork] *)
//
val () = intset2_foreach_cloref(G0, G1, $UN.cast(addr@fwork))
//
} (* end of [auxlink] *)
//
val+
~CHANNEL0(n0, G0, chmat0) = chan0
val+
~CHANNEL0(n1, G1, chmat1) = chan1
//
val G0_ =
  intset_ncomplement(G0, n0)
val G1_ =
  intset_ncomplement(G1, n1)
val G2_ = intset_union(G0_, G1_) // G0_*G1_ = 0
//
val (chan2_, chan2) = channel0_posneg(cap, n0, G2_)
//
val+ CHANNEL0(_, G2, _) = chan2
val+~CHANNEL0(_, G2_, chmat2_) = chan2_
//
val p0 = ptrcast(chmat0)
val p1 = ptrcast(chmat1)
val p0_ = p1 and p1_ = p0
val p2_ = ptrcast(chmat2_)
//
val () = auxlink(n0, G2, G0_, p0_, p2_)
val () = auxlink(n0, G2, G1_, p1_, p2_)
val () = auxlink(n0, G0_, G1_, p0_, p1_)
//
val chmat0 =
$UN.castvwtp0{matrixptr(ptr,0,0)}(chmat0)
val chmat1 =
$UN.castvwtp0{matrixptr(ptr,0,0)}(chmat1)
val chmat2_ =
$UN.castvwtp0{matrixptr(ptr,0,0)}(chmat2_)
//
val ((*freed*)) = matrixptr_free(chmat0)
val ((*freed*)) = matrixptr_free(chmat1)
val ((*freed*)) = matrixptr_free(chmat2_)
//
in
  chan2
end // end of [cchannel0_link]

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

(* end of [basic_channel0.dats] *)

(*
** Channel pairs
*)

(* ****** ****** *)
//
staload
"./../SATS/basis.sats"
staload
"./../SATS/intset.sats"
//
staload "./basis_uchan.dats"
//
(* ****** ****** *)
//
absvtype
channel0_vtype(a:vt@ype, n:int)
//
stadef channel0 = channel0_vtype
//
extern
praxi
lemma_channel0_param
  {a:vt0p}{n:int}
  (chan0: !channel0(a, n)): [n >= 0] void
//
(* ****** ****** *)
//
extern
fun
{a:vt0p}
channel0_posneg
  {n:nat}
(
  cap: intGt(0)
, nrole: int(n), G: intset(n)
) :
(
  channel0(a, n)(*pos*), channel0(a, n)(*neg*)
) (* end of [channel0_posneg] *)
//
(* ****** ****** *)
//
extern
fun
{a:vt0p}
channel0_free
  {n:int}(chan0: channel0(a, n)): void
//
(* ****** ****** *)
//
extern
fun{a:vt0p}
channel0_send
  {n:int}
(
  !channel0(a, n)
, i: natLt(n), j: natLt(n), x: a
) : void // end-of-function
//
extern
fun{a:vt0p}
channel0_recv
  {n:int}
(
  !channel0(a, n)
, i: natLt(n), j: natLt(n), x: &a? >> a
) : void // end-of-function
extern
fun{a:vt0p}
channel0_recv_val
  {n:int}
(
  !channel0(a, n), i: natLt(n), j: natLt(n)
) : (a) // end of [channel0_recv_val]
//
(* ****** ****** *)
//
extern
fun
{a:vt0p}
channel0_link
  {n:int}
(
  cap: intGt(0)
, chan0: channel0(a, n), chan1: channel0(a, n)
) : channel0(a, n)
//
(* ****** ****** *)
//
datavtype
channel0_
(
  a:vt@ype, n:int
) =
CHANNEL0 of
(
  int(n), intset(n)
, matrixptr(uchan(a), n, n)
) (* end of [channel0_] *)
//
(* ****** ****** *)
//
assume
channel0_vtype
  (a:vt0p, n:int) = channel0_(a, n)
//
(* ****** ****** *)

implement
{a}(*tmp*)
channel0_posneg
  {n}(cap, nrole, G0) = let
//
val G1 =
  intset_ncomplement(G0, nrole)
//
val nrow = i2sz(nrole)
val ncol = i2sz(nrole)
//
vtypedef uchan = uchan(a)
//
val
u0ch = the_null_ptr
val
chmat0 =
matrixptr_make_elt<ptr>(nrow, ncol, u0ch)
val
chmat1 =
matrixptr_make_elt<ptr>(nrow, ncol, u0ch)
//
val
chmat0 =
$UN.castvwtp0{matrixptr(uchan,n,n)}(chmat0)
val
chmat1 =
$UN.castvwtp0{matrixptr(uchan,n,n)}(chmat1)
//
val p0 = ptrcast(chmat0)
and p1 = ptrcast(chmat1)
//
var
fwork =
lam@
( i: natLt(n)
, j: natLt(n)
) : void =>
{
  val n = nrole
  val chx0 = uchan_make(cap)
  and chy0 = uchan_make(cap)
  val chx1 = uchan_ref(chx0)
  and chy1 = uchan_ref(chy0)
  val ij = i * n + j and ji = j * n + i
  val () = $UN.ptr0_set_at<uchan>(p0, ij, chx0)
  val () = $UN.ptr0_set_at<uchan>(p0, ji, chy0)
  val () = $UN.ptr0_set_at<uchan>(p1, ij, chx1)
  val () = $UN.ptr0_set_at<uchan>(p1, ji, chy1)
} (* end of [fwork] *)
//
val () =
  intset2_foreach_cloref(G0, G1, $UN.cast(addr@fwork))
//
in
  (CHANNEL0(nrole, G0, chmat0), CHANNEL0(nrole, G1, chmat1))
end // end of [channel0_posneg]

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

implement
{a}(*tmp*)
channel0_free
  (chan0) = let
//
val () =
lemma_channel0_param(chan0)
//
val
~CHANNEL0(n, G, chmat) = chan0
//
implement
(elt:vtype)
matrix_uninitize$clear<elt>
  (i, j, x) = let
//
val x = $UN.castvwtp0{ptr}(x)
//
in
//
if
isneqz(x)
then (
  uchan_unref($UN.castvwtp0{uchan(a)}(x))
) (* end of [if] *)
//
end // end of [matrix_uninitize$clear]
//
val n = i2sz(n)
//
val () = matrixptr_freelin(chmat, n, n)
//
in
  // nothing
end // end of [channel0_free]

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

implement
{a}(*tmp*)
channel0_send
  (chan0, i, j, x0) =
{
//
val+CHANNEL0(n, G, chmat) = chan0
//
val p0 = ptrcast(chmat)
//
val uch =
  $UN.ptr0_get_at<uchan(a)>(p0, i*n+j)
//
val ((*void*)) = uchan_insert<a> (uch, x0)
//
val ((*returned*)) = $UN.cast2void(uch)
//
} (* end of [channel0_send] *)

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

implement
{a}(*tmp*)
channel0_recv
  (chan0, i, j, x0) = let
//
val+CHANNEL0(n, G, chmat) = chan0
//
val p0 = ptrcast(chmat)
//
val p_ij =
  ptr_add<uchan(a)>(p0, i*n+j)
//
val (pf, fpf | p_ij) =
  $UN.ptr_vtake{uchan(a)}(p_ij)
//
val () = (x0 := uchan_remove<a> (!p_ij))
//
prval ((*returned*)) = fpf(pf)
//
in
  // nothing
end // end of [channel0_recv]

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

implement
{a}(*tmp*)
channel0_recv_val
  (chan0, i, j) = x0 where
{
//
var x0: a // uninitized
//
val () = channel0_recv(chan0, i, j, x0)
//
} (* end of [channel0_recv_val] *)

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

implement
{a}(*tmp*)
channel0_link
  (cap, chan0, chan1) = let
//
prval() =
  lemma_channel0_param(chan0)
prval() =
  lemma_channel0_param(chan1)
//
fun
auxlink{n:nat}
(
  n: int(n)
, G0: intset(n), G1: intset(n), p0: ptr, p1: ptr
) : void =
{
//
vtypedef
uchan = uchan(a)
//
var
fwork =
lam@
( i: natLt(n)
, j: natLt(n)
) : void =>
{
//
  val ij = i * n + j
  val ch0_ij =
    $UN.ptr0_get_at<uchan>(p0, ij)
  val ch1_ij =
    $UN.ptr0_get_at<uchan>(p1, ij)
  val () = uchan_qinsert(ch0_ij, ch1_ij)
  val ((*freed*)) = uchan_unref(ch0_ij)
//
  val ji = j * n + i
  val ch0_ji =
    $UN.ptr0_get_at<uchan>(p0, ji)
  val ch1_ji =
    $UN.ptr0_get_at<uchan>(p1, ji)
  val () = uchan_qinsert(ch1_ji, ch0_ji)
  val ((*freed*)) = uchan_unref(ch1_ji)
//
} (* end of [fwork] *)
//
val () = intset2_foreach_cloref(G0, G1, $UN.cast(addr@fwork))
//
} (* end of [auxlink] *)
//
val+
~CHANNEL0(n0, G0, chmat0) = chan0
val+
~CHANNEL0(n1, G1, chmat1) = chan1
//
val G2 = intset_union(G0, G1) // HX: G0*G1 = 0
//
val (chan2, chan2_) = channel0_posneg(cap, n0, G2)
//
val+~CHANNEL0(_, G2_, chmat2_) = chan2_
//
val p0 = ptrcast(chmat0)
val p1 = ptrcast(chmat1)
val p2_ = ptrcast(chmat2_)
//
val () = auxlink(n0, G0, G1, p0, p1)
val () = auxlink(n0, G0, G2_, p0, p2_)
val () = auxlink(n1, G1, G2_, p1, p2_)
//
val chmat0 =
$UN.castvwtp0{matrixptr(ptr,0,0)}(chmat0)
val chmat1 =
$UN.castvwtp0{matrixptr(ptr,0,0)}(chmat1)
val chmat2_ =
$UN.castvwtp0{matrixptr(ptr,0,0)}(chmat2_)
//
val ((*freed*)) = matrixptr_free(chmat0)
val ((*freed*)) = matrixptr_free(chmat1)
val ((*freed*)) = matrixptr_free(chmat2_)
//
in
  chan2
end // end of [channel0_link]

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

(* end of [basic_channel0.dats] *)


Done read if failure, so prevent bad transactions

#include "config.hats"
#include "{$TOP}/avr_prelude/kernel_staload.hats"
staload "{$TOP}/SATS/arduino.sats"
staload "{$TOP}/SATS/i2c.sats"
staload "{$TOP}/SATS/crc.sats"

//staload UN = "prelude/SATS/unsafe.sats"
staload "prelude/SATS/unsafe.sats"

macdef i8(x) = cast{int8}(,(x))
macdef u8(x) = cast{uint8}(,(x))
macdef u16(x) = cast{uint16}(,(x))

macdef
ifnerr(x, err, ec, t) =
(
if
(,(err) = ,(t)(0))
then let
  val () = ,(err) := ,(x)
in
  if ,(err) != ,(t)(0) then ,(err) := ,(t)(,(ec))
end // end of [then]
)

macdef err (z, t) = ,(t)(,(z))

fun wa (addr:uint8) : uint8 = addr << 1
fun ra (addr:uint8) : uint8 = (addr << 1) + u8(1)

implement i2c_start () = u8(i2c_start_p())
implement i2c_repeated_start () = u8(i2c_repeated_start_p())
implement i2c_write (b) = u8(i2c_write_p(b))
implement i2c_read (b) = i2c_read_p(i8(b))

implement i2c_read_byte(address: uint8): (uint8, uint8) = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val b  =        i2c_read(u8(WITH_NACK))
  val () =        i2c_stop()
  in (err, b) end

implement i2c_read_byte_pec(address: uint8): (uint8, uint8) = let
  var err: uint8 =                         err (0, u8)
  val ()   = ifnerr(i2c_start(),           err, 1, u8)
  val ()   = ifnerr(i2c_write(wa address), err, 2, u8)
  val b    =        i2c_read(u8(WITH_ACK))
  val pec  =        i2c_read(u8(WITH_NACK))
  val ()   =        i2c_stop()
  val err2 = if err = u8(1) then err else if pec = pec_add(pec_add(u8(0), address), b) then u8(0) else u8(1)
  in (err2, b) end

implement i2c_write_byte(address: uint8, data: uint8): uint8 = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val () = ifnerr(i2c_write(data),       err, 3, u8)
  val () =        i2c_stop()
  in err end

implement i2c_write_byte_pec(address: uint8, data: uint8): uint8 = let
  var err: uint8 =                                 err (0, u8)
  val pec = pec_add(pec_add(u8(0), address), data)
  val ()  = ifnerr(i2c_start(),                    err, 1, u8)
  val ()  = ifnerr(i2c_write(wa address),          err, 2, u8)
  val ()  = ifnerr(i2c_write(data),                err, 3, u8)
  val ()  = ifnerr(i2c_write(pec),                 err, 3, u8)
  val ()  =        i2c_stop()
  in err end

implement i2c_read_byte_data(address: uint8, command: uint8): (uint8, uint8) = let
  val _ = print! "iirbd "
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val _ = print! err
  val _ = print! " "
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val _ = print! err
  val _ = print! " "
  val () = ifnerr(i2c_write(command),    err, 3, u8)
  val _ = print! err
  val _ = print! " done"
  val () = ifnerr(i2c_start(),           err, 4, u8)
  val () = ifnerr(i2c_write(ra address), err, 5, u8)
  val b  = if err = u8(0) then i2c_read(u8(WITH_NACK)) else u8(0)
  val () =        i2c_stop()
  in (err, b) end

implement i2c_read_byte_data_pec(address: uint8, command: uint8): (uint8, uint8) = let
  var err: uint8 =                         err (0, u8)
  val ()   = ifnerr(i2c_start(),           err, 1, u8)
  val ()   = ifnerr(i2c_write(wa address), err, 2, u8)
  val ()   = ifnerr(i2c_write(command),    err, 3, u8)
  val ()   = ifnerr(i2c_start(),           err, 4, u8)
  val ()   = ifnerr(i2c_write(ra address), err, 5, u8)
  val b    = if err = u8(0) then i2c_read(u8(WITH_ACK)) else u8(0)
  val pec  = if err = u8(0) then i2c_read(u8(WITH_NACK)) else u8(0)
  val ()   = i2c_stop()
  val err2 = if err = u8(1) then err else if pec = pec_add(pec_add(pec_add(u8(0), address), command), b) then u8(0) else u8(1)
  in (err2, b) end

implement i2c_write_byte_data(address: uint8, command: uint8, data: uint8): uint8 = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val () = ifnerr(i2c_write(command),    err, 3, u8)
  val () = ifnerr(i2c_write(data),       err, 4, u8)
  val () =        i2c_stop()
  in err end

implement i2c_write_byte_data_pec(address: uint8, command: uint8, data: uint8): uint8 = let
  var err: uint8 =                                                    err (0, u8)
  val pec = pec_add(pec_add(pec_add(u8(0), address), command), data)
  val ()  = ifnerr(i2c_start(),                                       err, 1, u8)
  val ()  = ifnerr(i2c_write(wa address),                             err, 2, u8)
  val ()  = ifnerr(i2c_write(command),                                err, 3, u8)
  val ()  = ifnerr(i2c_write(data),                                   err, 4, u8)
  val ()  = ifnerr(i2c_write(pec),                                    err, 3, u8)
  val ()  = i2c_stop()
  in err end

implement i2c_read_word_data(address: uint8, command: uint8): (uint8, uint16) = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val () = ifnerr(i2c_write(command),    err, 3, u8)
  val () = ifnerr(i2c_start(),           err, 4, u8)
  val () = ifnerr(i2c_write(ra address), err, 5, u8)
  val b1 = if err = u8(0) then i2c_read(u8(WITH_ACK)) else u8(0)
  val b0 = if err = u8(0) then i2c_read(u8(WITH_NACK)) else u8(0)
  val () = i2c_stop()
  val w  = (u16(b1) << 8) + u16(b0)
  in (err, w) end

implement i2c_read_word_data_pec(address: uint8, command: uint8): (uint8, uint16) = let
  var err: uint8 =                         err (0, u8)
  val ()   = ifnerr(i2c_start(),           err, 1, u8)
  val ()   = ifnerr(i2c_write(wa address), err, 2, u8)
  val ()   = ifnerr(i2c_write(command),    err, 3, u8)
  val ()   = ifnerr(i2c_start(),           err, 4, u8)
  val ()   = ifnerr(i2c_write(ra address), err, 5, u8)
  val b1   = if err = u8(0) then i2c_read(u8(WITH_ACK)) else u8(0)
  val b0   = if err = u8(0) then i2c_read(u8(WITH_ACK)) else u8(0)
  val pec  = if err = u8(0) then i2c_read(u8(WITH_NACK)) else u8(0)
  val ()   = i2c_stop()
  val w    = (u16(b1) << 8) + u16(b0)
  val err2 = if err = u8(1) then err else if pec = pec_add(pec_add(pec_add(pec_add(u8(0), address), command), b1), b0) then u8(0) else u8(1)
  in (err2, w) end

implement i2c_write_word_data(address: uint8, command: uint8, data: uint16): uint8 = let
  var err: uint8 =                                          err (0, u8)
  val () = ifnerr(i2c_start(),                              err, 1, u8)
  val () = ifnerr(i2c_write(wa address),                    err, 2, u8)
  val () = ifnerr(i2c_write(command),                       err, 3, u8)
  val () = ifnerr(i2c_write(u8(data >> 8)),                 err, 4, u8)
  val () = ifnerr(i2c_write(u8(data - ((data >> 8) << 8))), err, 5, u8)
  val () =        i2c_stop()
  in err end

implement i2c_write_word_data_pec(address: uint8, command: uint8, data: uint16): uint8 = let
  var err: uint8 =                                                                            err (0, u8)
  val data0 = u8(data >> 8)
  val data1 = u8(data - ((data >> 8) << 8))
  val pec = pec_add(pec_add(pec_add(pec_add(u8(0), address), command), data0), data1)
  val ()  = ifnerr(i2c_start(),                                                               err, 1, u8)
  val ()  = ifnerr(i2c_write(wa address),                                                     err, 2, u8)
  val ()  = ifnerr(i2c_write(command),                                                        err, 3, u8)
  val ()  = ifnerr(i2c_write(data0),                                                          err, 4, u8)
  val ()  = ifnerr(i2c_write(data1),                                                          err, 5, u8)
  val ()  = ifnerr(i2c_write(pec),                                                            err, 3, u8)
  val ()  = i2c_stop()
  in err end

#include "config.hats"
#include "{$TOP}/avr_prelude/kernel_staload.hats"
staload "{$TOP}/SATS/arduino.sats"
staload "{$TOP}/SATS/i2c.sats"
staload "{$TOP}/SATS/crc.sats"

//staload UN = "prelude/SATS/unsafe.sats"
staload "prelude/SATS/unsafe.sats"

macdef i8(x) = cast{int8}(,(x))
macdef u8(x) = cast{uint8}(,(x))
macdef u16(x) = cast{uint16}(,(x))

macdef
ifnerr(x, err, ec, t) =
(
if
(,(err) = ,(t)(0))
then let
  val () = ,(err) := ,(x)
in
  if ,(err) != ,(t)(0) then ,(err) := ,(t)(,(ec))
end // end of [then]
)

macdef err (z, t) = ,(t)(,(z))

fun wa (addr:uint8) : uint8 = addr << 1
fun ra (addr:uint8) : uint8 = (addr << 1) + u8(1)

implement i2c_start () = u8(i2c_start_p())
implement i2c_repeated_start () = u8(i2c_repeated_start_p())
implement i2c_write (b) = u8(i2c_write_p(b))
implement i2c_read (b) = i2c_read_p(i8(b))

implement i2c_read_byte(address: uint8): (uint8, uint8) = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val b  =        i2c_read(u8(WITH_NACK))
  val () =        i2c_stop()
  in (err, b) end

implement i2c_read_byte_pec(address: uint8): (uint8, uint8) = let
  var err: uint8 =                         err (0, u8)
  val ()   = ifnerr(i2c_start(),           err, 1, u8)
  val ()   = ifnerr(i2c_write(wa address), err, 2, u8)
  val b    =        i2c_read(u8(WITH_ACK))
  val pec  =        i2c_read(u8(WITH_NACK))
  val ()   =        i2c_stop()
  val err2 = if err = u8(1) then err else if pec = pec_add(pec_add(u8(0), address), b) then u8(0) else u8(1)
  in (err2, b) end

implement i2c_write_byte(address: uint8, data: uint8): uint8 = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val () = ifnerr(i2c_write(data),       err, 3, u8)
  val () =        i2c_stop()
  in err end

implement i2c_write_byte_pec(address: uint8, data: uint8): uint8 = let
  var err: uint8 =                                 err (0, u8)
  val pec = pec_add(pec_add(u8(0), address), data)
  val ()  = ifnerr(i2c_start(),                    err, 1, u8)
  val ()  = ifnerr(i2c_write(wa address),          err, 2, u8)
  val ()  = ifnerr(i2c_write(data),                err, 3, u8)
  val ()  = ifnerr(i2c_write(pec),                 err, 3, u8)
  val ()  =        i2c_stop()
  in err end

implement i2c_read_byte_data(address: uint8, command: uint8): (uint8, uint8) = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val () = ifnerr(i2c_write(command),    err, 3, u8)
  val () = ifnerr(i2c_start(),           err, 4, u8)
  val () = ifnerr(i2c_write(ra address), err, 5, u8)
  val b  =        i2c_read(u8(WITH_NACK))
  val () =        i2c_stop()
  in (err, b) end

implement i2c_read_byte_data_pec(address: uint8, command: uint8): (uint8, uint8) = let
  var err: uint8 =                         err (0, u8)
  val ()   = ifnerr(i2c_start(),           err, 1, u8)
  val ()   = ifnerr(i2c_write(wa address), err, 2, u8)
  val ()   = ifnerr(i2c_write(command),    err, 3, u8)
  val ()   = ifnerr(i2c_start(),           err, 4, u8)
  val ()   = ifnerr(i2c_write(ra address), err, 5, u8)
  val b    = i2c_read(u8(WITH_ACK))
  val pec  = i2c_read(u8(WITH_NACK))
  val ()   = i2c_stop()
  val err2 = if err = u8(1) then err else if pec = pec_add(pec_add(pec_add(u8(0), address), command), b) then u8(0) else u8(1)
  in (err2, b) end

implement i2c_write_byte_data(address: uint8, command: uint8, data: uint8): uint8 = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val () = ifnerr(i2c_write(command),    err, 3, u8)
  val () = ifnerr(i2c_write(data),       err, 4, u8)
  val () =        i2c_stop()
  in err end

implement i2c_write_byte_data_pec(address: uint8, command: uint8, data: uint8): uint8 = let
  var err: uint8 =                                                    err (0, u8)
  val pec = pec_add(pec_add(pec_add(u8(0), address), command), data)
  val ()  = ifnerr(i2c_start(),                                       err, 1, u8)
  val ()  = ifnerr(i2c_write(wa address),                             err, 2, u8)
  val ()  = ifnerr(i2c_write(command),                                err, 3, u8)
  val ()  = ifnerr(i2c_write(data),                                   err, 4, u8)
  val ()  = ifnerr(i2c_write(pec),                                    err, 3, u8)
  val ()  = i2c_stop()
  in err end

implement i2c_read_word_data(address: uint8, command: uint8): (uint8, uint16) = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val () = ifnerr(i2c_write(command),    err, 3, u8)
  val () = ifnerr(i2c_start(),           err, 4, u8)
  val () = ifnerr(i2c_write(ra address), err, 5, u8)
  val b1 = i2c_read(u8(WITH_ACK))
  val b0 = i2c_read(u8(WITH_NACK))
  val () = i2c_stop()
  val w  = (u16(b1) << 8) + u16(b0)
  in (err, w) end

implement i2c_read_word_data_pec(address: uint8, command: uint8): (uint8, uint16) = let
  var err: uint8 =                         err (0, u8)
  val ()   = ifnerr(i2c_start(),           err, 1, u8)
  val ()   = ifnerr(i2c_write(wa address), err, 2, u8)
  val ()   = ifnerr(i2c_write(command),    err, 3, u8)
  val ()   = ifnerr(i2c_start(),           err, 4, u8)
  val ()   = ifnerr(i2c_write(ra address), err, 5, u8)
  val b1   = i2c_read(u8(WITH_ACK))
  val b0   = i2c_read(u8(WITH_ACK))
  val pec  = i2c_read(u8(WITH_NACK))
  val ()   = i2c_stop()
  val w    = (u16(b1) << 8) + u16(b0)
  val err2 = if err = u8(1) then err else if pec = pec_add(pec_add(pec_add(pec_add(u8(0), address), command), b1), b0) then u8(0) else u8(1)
  in (err2, w) end

implement i2c_write_word_data(address: uint8, command: uint8, data: uint16): uint8 = let
  var err: uint8 =                                          err (0, u8)
  val () = ifnerr(i2c_start(),                              err, 1, u8)
  val () = ifnerr(i2c_write(wa address),                    err, 2, u8)
  val () = ifnerr(i2c_write(command),                       err, 3, u8)
  val () = ifnerr(i2c_write(u8(data >> 8)),                 err, 4, u8)
  val () = ifnerr(i2c_write(u8(data - ((data >> 8) << 8))), err, 5, u8)
  val () =        i2c_stop()
  in err end

implement i2c_write_word_data_pec(address: uint8, command: uint8, data: uint16): uint8 = let
  var err: uint8 =                                                                            err (0, u8)
  val data0 = u8(data >> 8)
  val data1 = u8(data - ((data >> 8) << 8))
  val pec = pec_add(pec_add(pec_add(pec_add(u8(0), address), command), data0), data1)
  val ()  = ifnerr(i2c_start(),                                                               err, 1, u8)
  val ()  = ifnerr(i2c_write(wa address),                                                     err, 2, u8)
  val ()  = ifnerr(i2c_write(command),                                                        err, 3, u8)
  val ()  = ifnerr(i2c_write(data0),                                                          err, 4, u8)
  val ()  = ifnerr(i2c_write(data1),                                                          err, 5, u8)
  val ()  = ifnerr(i2c_write(pec),                                                            err, 3, u8)
  val ()  = i2c_stop()
  in err end