Updating: very minorly tidying-up

Updating: very minorly tidying-up

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

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

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

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

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

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

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

end // end of [local]

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

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

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

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

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

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

  } (* end of [ATStailcalseq] *)
//
| ATSINSmove_tlcal (tmp, d0e) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_tmpvar (out, tmp)
    val () = emit_text (out, " = ")
    val () = emit_d0exp (out, d0e)
    val () = emit_SEMICOLON (out)
  } (* end of [ATSINSmove_tlcal] *)
//
| ATSINSargmove_tlcal (tmp1, tmp2) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_tmpvar (out, tmp1)
    val () = emit_text (out, " = ")
    val () = emit_tmpvar (out, tmp2)
    val () = emit_SEMICOLON (out)
  } (* end of [ATSINSargmove_tlcal] *)
//
| ATSINSextvar_assign (ext, d0e_r) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_d0exp (out, ext)
    val () = emit_text (out, " = ")
    val () = emit_d0exp (out, d0e_r)
    val () = emit_SEMICOLON (out)
  }
| ATSINSdyncst_valbind (d2c, d0e_r) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_i0de (out, d2c)
    val () = emit_text (out, " = ")
    val () = emit_d0exp (out, d0e_r)
    val () = emit_SEMICOLON (out)
  }
//
| ATSINScaseof_fail (errmsg) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "ATSINScaseof_fail")
    val () = emit_LPAREN (out)
    val () = emit_PMVstring (out, errmsg)
    val () = emit_RPAREN (out)
    val () = emit_SEMICOLON (out)
  }
| ATSINSdeadcode_fail (__tok__) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "ATSINSdeadcode_fail()")
    val () = emit_SEMICOLON (out)
  }
//
| ATSdynload (dummy) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATSdynload()")
  }
//
| ATSdynloadset (flag) =>
  {
    val () = emit_nspc (out, ind)
    val () = (
      emit_tmpvar (out, flag); emit_text (out, " = 1 ; // flag is set")
    ) (* end of [val] *)
  }
//
| ATSdynloadfcall (fcall) =>
  {
    val () = emit_nspc (out, ind)
    val () = (
      emit_tmpvar (out, fcall); emit_text (out, "(/*void*/) ; // dynloading")
    ) (* end of [val] *)
  }
//
| ATSdynloadflag_sta (flag) =>
  {
    val () = emit_nspc (out, ind)
    val () = fprint! (out, "// ATSdynloadflag_sta(", flag, ")")
  }
| ATSdynloadflag_ext (flag) =>
  {
    val () = emit_nspc (out, ind)
    val () = fprint! (out, "// ATSdynloadflag_ext(", flag, ")")
  }
//
| _ (*rest-of-instr*) =>
  {
    val () = emit_nspc (out, ind)
    val ((*error*)) = fprint! (out, "UNRECOGNIZED-INSTRUCTION: ", ins0)
  }
//
end // end of [emit2_instr]

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

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

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

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

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

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

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

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

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

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

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

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

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

implement
emit2_ATSINSmove_delay
  (out, ind, ins0) = let
//
val-
ATSINSmove_delay
  (tmp, s0e, thunk) = ins0.instr_node
//
val () = emit_nspc (out, ind)
val () = emit_tmpvar (out, tmp)
val () = emit_text (out, " = ")
//
val () = emit_LBRACKET (out)
val () =
(
  emit_int (out, 0); emit_text (out, ", "); emit_d0exp (out, thunk)
) (* end of [val] *)
val () = emit_RBRACKET (out)
//
in
  // nothing
end // end of [emit2_ATSINSmove_delay]

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

implement
emit2_ATSINSmove_lazyeval
  (out, ind, ins0) = let
//
val-
ATSINSmove_lazyeval
  (tmp, s0e, lazyval) = ins0.instr_node
//
val () = emit_nspc (out, ind)
val () = emit_text (out, "ATSPMVlazyval_eval")
val () = emit_text (out, "(")
val () = emit_d0exp (out, lazyval)
val () = emit_text (out, "); ")
val () = emit_tmpvar (out, tmp)
val () = emit_text (out, " = ")
val () = emit_d0exp (out, lazyval)
val () =
(
  emit_text (out, "["); emit_int (out, 1); emit_text (out, "];")
) (* end of [val] *)
//
in
  // nothing
end // end of [emit2_ATSINSmove_lazyeval]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

(* end of [catsparse_emit2_js.dats] *)

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

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

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

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

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

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

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

end // end of [local]

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

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

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

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

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

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

  } (* end of [ATStailcalseq] *)
//
| ATSINSmove_tlcal (tmp, d0e) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_tmpvar (out, tmp)
    val () = emit_text (out, " = ")
    val () = emit_d0exp (out, d0e)
    val () = emit_SEMICOLON (out)
  } (* end of [ATSINSmove_tlcal] *)
//
| ATSINSargmove_tlcal (tmp1, tmp2) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_tmpvar (out, tmp1)
    val () = emit_text (out, " = ")
    val () = emit_tmpvar (out, tmp2)
    val () = emit_SEMICOLON (out)
  } (* end of [ATSINSargmove_tlcal] *)
//
| ATSINSextvar_assign (ext, d0e_r) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_d0exp (out, ext)
    val () = emit_text (out, " = ")
    val () = emit_d0exp (out, d0e_r)
    val () = emit_SEMICOLON (out)
  }
| ATSINSdyncst_valbind (d2c, d0e_r) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_i0de (out, d2c)
    val () = emit_text (out, " = ")
    val () = emit_d0exp (out, d0e_r)
    val () = emit_SEMICOLON (out)
  }
//
| ATSINScaseof_fail (errmsg) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "ATSINScaseof_fail")
    val () = emit_LPAREN (out)
    val () = emit_PMVstring (out, errmsg)
    val () = emit_RPAREN (out)
    val () = emit_SEMICOLON (out)
  }
| ATSINSdeadcode_fail (__tok__) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "ATSINSdeadcode_fail()")
    val () = emit_SEMICOLON (out)
  }
//
| ATSdynload (dummy) =>
  {
    val () = emit_nspc (out, ind)
    val () = emit_text (out, "// ATSdynload()")
  }
//
| ATSdynloadset (flag) =>
  {
    val () = emit_nspc (out, ind)
    val () = (
      emit_tmpvar (out, flag); emit_text (out, " = 1 ; // flag is set")
    ) (* end of [val] *)
  }
//
| ATSdynloadfcall (fcall) =>
  {
    val () = emit_nspc (out, ind)
    val () = (
      emit_tmpvar (out, fcall); emit_text (out, "(/*void*/) ; // dynloading")
    ) (* end of [val] *)
  }
//
| ATSdynloadflag_sta (flag) =>
  {
    val () = emit_nspc (out, ind)
    val () = fprint! (out, "// ATSdynloadflag_sta(", flag, ")")
  }
| ATSdynloadflag_ext (flag) =>
  {
    val () = emit_nspc (out, ind)
    val () = fprint! (out, "// ATSdynloadflag_ext(", flag, ")")
  }
//
| _ (*rest-of-instr*) =>
  {
    val () = emit_nspc (out, ind)
    val ((*error*)) = fprint! (out, "UNRECOGNIZED-INSTRUCTION: ", ins0)
  }
//
end // end of [emit2_instr]

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

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

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

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

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

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

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

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

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

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

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

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

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

implement
emit2_ATSINSmove_delay
  (out, ind, ins0) = let
//
val-
ATSINSmove_delay
  (tmp, s0e, thunk) = ins0.instr_node
//
val () = emit_nspc (out, ind)
val () = emit_tmpvar (out, tmp)
val () = emit_text (out, " = ")
//
val () = emit_LBRACKET (out)
val () =
(
  emit_int (out, 0); emit_text (out, ", "); emit_d0exp (out, thunk)
) (* end of [val] *)
val () = emit_RBRACKET (out)
//
in
  // nothing
end // end of [emit2_ATSINSmove_delay]

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

implement
emit2_ATSINSmove_lazyeval
  (out, ind, ins0) = let
//
val-
ATSINSmove_lazyeval
  (tmp, s0e, lazyval) = ins0.instr_node
//
val () = emit_nspc (out, ind)
val () = emit_text (out, "ATSPMVlazyval_eval")
val () = emit_text (out, "(")
val () = emit_d0exp (out, lazyval)
val () = emit_text (out, "); ")
val () = emit_tmpvar (out, tmp)
val () = emit_text (out, " = ")
val () = emit_d0exp (out, lazyval)
val () =
(
  emit_text (out, "["); emit_int (out, 1); emit_text (out, "];")
) (* end of [val] *)
//
in
  // nothing
end // end of [emit2_ATSINSmove_lazyeval]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

(* end of [catsparse_emit2_js.dats] *)


Updating: very very minorly

Updating: very very minorly

(*
##
## ATS-extsolve-smt2:
## Outputing ATS-constraints
## in the format of smt-lib2
##
*)

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

(*
//
** Author: Hongwei Xi
** Authoremail: gmhwxiATgmailDOTcom
** Start time: June, 2016
//
** Author: William Blair
** Authoremail: wdblairATgmailDOTcom
** Start time: Some time in 2015
//
*)

(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
staload
STDIO =
"libats/libc/SATS/stdio.sats"
//
(* ****** ****** *)
//
#define
PATSOLVE_targetloc"./.ATS-extsolve"
//
staload
"{$PATSOLVE}/patsolve_cnstrnt.sats"
staload
"{$PATSOLVE}/patsolve_parsing.sats"
//
(* ****** ****** *)

staload "./patsolve_smt2_commarg.sats"
staload "./patsolve_smt2_solving.sats"

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

implement
fprint_commarg(out, ca) = (
//
case+ ca of
//
| CAhelp(str) =>
    fprint! (out, "CAhelp(", str, ")")
//
| CAgitem(str) =>
    fprint! (out, "CAgitem(", str, ")")
//
| CAinput(str) =>
    fprint! (out, "CAinput(", str, ")")
//
| CAoutput(knd, str) =>
    fprint! (out, "CAoutput(", knd, ", ", str, ")")
//
| CAprintln(str) =>
    fprint! (out, "CAprintln(", str, ")")
| CAprintfile(str) =>
    fprint! (out, "CAprintfile(", str, ")")
//
| CAargend((*void*)) => fprint! (out, "CAargend(", ")")
//
) (* end of [fprint_commarg] *)

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

fun{
} argv_getopt_at
  {n:int}{i:nat}
(
  n: int n, argv: !argv(n), i: int i
) : stropt =
(
//
if i < n
  then stropt_some (argv[i]) else stropt_none ()
// end of [if]
//
) (* end of [argv_getopt_at] *)

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

implement
patsolve_smt2_cmdline
  (argc, argv) = let
//
vtypedef
res_vt = commarglst_vt
//
fun
aux
{n:int}
{i:nat | i <= n}
(
  argc: int n
, argv: !argv(n)
, i: int i, res0: res_vt
) : res_vt = let
in
//
if
i < argc
then let
//
val arg = argv[i]
//
in
//
case+ arg of
//
| "-h" => let
    val ca =
      CAhelp(arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux(argc, argv, i+1, res0)
  end // end of ...
| "--help" => let
    val ca =
      CAhelp(arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux(argc, argv, i+1, res0)
  end // end of ...
//
| "-i" => let
    val ca =
      CAinput(arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux2(argc, argv, i+1, res0)
  end // end of ...
| "--input" => let
    val ca =
      CAinput(arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux2(argc, argv, i+1, res0)
  end // end of ...
//
| "-o" => let
    val ca =
      CAoutput(0, arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux2(argc, argv, i+1, res0)
  end // end of ...
| "--output" => let
    val ca =
      CAoutput(0, arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux2(argc, argv, i+1, res0)
  end // end of ...
| "--output-w" => let
    val ca =
      CAoutput(1, arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux2(argc, argv, i+1, res0)
  end // end of ...
| "--output-a" => let
    val ca =
      CAoutput(2, arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux2(argc, argv, i+1, res0)
  end // end of ...
//
| "--println" => let
    val ca =
      CAprintln(arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux2(argc, argv, i+1, res0)
  end // end of ...
//
| "--printfile" => let
    val ca =
      CAprintfile(arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux2(argc, argv, i+1, res0)
  end // end of ...
//
| _ (*rest*) => let
    val ca =
      CAgitem(arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux(argc, argv, i+1, res0)
  end // end of [...]
//
end // end of [then]
else res0 // end of [else]
//
end // end of [aux]
//
and
aux2
{n:int}
{i:nat | i <= n}
(
  argc: int n
, argv: !argv(n)
, i: int i, res0: res_vt
) : res_vt = let
in
if
i < argc
then let
//
val arg = argv[i]
//
val ca =
  CAgitem(arg)
val res0 =
  cons_vt(ca, res0)
// end of [val]
in
  aux(argc, argv, i+1, res0)
end // end of [then]
else res0 // end of [else]
//
end // end of [aux2]
//
val args = aux(argc, argv, 0, nil_vt)
//
in
//
list_vt_reverse(list_vt_cons(CAargend(), args))
//
end // end of [patsolve_smt2_cmdline]

(* ****** ****** *)
//
extern fun patsolve_smt2_help(): void
//
extern fun patsolve_smt2_gitem(string): void
//
extern fun patsolve_smt2_input((*void*)): void
extern fun patsolve_smt2_input_arg(string): void
//
extern fun patsolve_smt2_output(knd: int): void
extern fun patsolve_smt2_output_arg(string): void
//
extern fun patsolve_smt2_println(): void
extern fun patsolve_smt2_printfile(): void
extern fun patsolve_smt2_printfile_arg(string): void
//
extern fun patsolve_smt2_argend((*void*)): void
//
extern fun patsolve_smt2_commarglst_finalize(): void
//
(* ****** ****** *)

typedef
state_struct =
@{
//
  nerr= int
//
, input= int
//
, ninput= int
//
, inpfil_ref= FILEref
//
, output= int
//
, fopen_out= int
, outfil_ref= FILEref
, outfil_mod= file_mode
//
, println= int
, printfile= int
//
, constraint_real= int
//
} (* end of [state_struct] *)

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

local
//
var
the_state: state_struct?
//
val () = the_state.nerr := 0
//
val () = the_state.input := 0
val () = the_state.ninput := 0
//
val () = the_state.inpfil_ref := stdin_ref
//
val () = the_state.output := 0
//
val () = the_state.fopen_out := 0
val () = the_state.outfil_ref := stdout_ref
val () = the_state.outfil_mod := file_mode_w
//
val () = the_state.println := 0
val () = the_state.printfile := 0
//
val () = the_state.constraint_real := 0
//
in (* in-of-local *)
//
val
the_state
  : ref(state_struct) =
  ref_make_viewptr(view@the_state | addr@the_state)
//
end // end of [local]

(* ****** ****** *)
//
implement
the_constraint_real
  ((*void*)) = !the_state.constraint_real
//
(* ****** ****** *)

fun
process_arg
  (x: commarg): void = let
//
(*
val () =
fprintln!
(
  stdout_ref
, "patsolve_smt2_commarglst: process_arg: x = ", x
) (* end of [val] *)
*)
//
in
//
case+ x of
//
| CAhelp _ => patsolve_smt2_help()
//
| CAgitem
    (str) => patsolve_smt2_gitem(str)
  // CAgitem
//
| CAinput _ => patsolve_smt2_input()
//
| CAoutput
    (knd, _) => patsolve_smt2_output(knd)
  // CAoutput
//
| CAprintln _ => patsolve_smt2_println()
| CAprintfile _ => patsolve_smt2_printfile()
//
| CAargend((*void*)) => patsolve_smt2_argend()
//
end // end of [process_arg]

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

implement
patsolve_smt2_commarglst
  (xs) = let
(*
val () = println! ("patsolve_smt2_commarglst")
*)
in
//
case+ xs of
| ~list_vt_cons
    (x, xs) => let
    val () = process_arg(x)
  in
    patsolve_smt2_commarglst (xs)
  end // end of [list_vt_cons]
//
| ~list_vt_nil
    ((*void*)) => patsolve_smt2_commarglst_finalize ()
  // end of [list_vt_nil]
//
end // end of [patsolve_smt2_commarglst]

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

implement
patsolve_smt2_help() = let
//
val out = stdout_ref
val cmdname = "patsolve_smt2"
//
in
//
fprintln!
  (out, "Usage: ", cmdname, " <command> ... <command>\n");
fprintln!
  (out, "where a <command> is of one of the following forms:\n");
//
fprintln! (out, "  -h (for printing out this help usage)");
fprintln! (out, "  -i <filename> (input from <filename>)");
fprintln! (out, "  -o <filename> (output into <filename>)");
//
fprintln! (out);
//
fprintln! (out, "  --help (for printing out this help usage)");
//
fprintln! (out, "  --input <filename> (input from <filename>)");
//
fprintln! (out, "  --output <filename> (output into <filename>)");
fprintln! (out, "  --output-w <filename> (output-write into <filename>)");
fprintln! (out, "  --output-a <filename> (output-append into <filename>)");
//
fprintln! (out, "  --println <string> (print <string>+newline)");
fprintln! (out, "  --printfile <filename> (print the content of <filename>)");
//
fprintln! (out);
//
end (* end of [patsolve_smt2_help] *)

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

implement
patsolve_smt2_input() =
{
//
(*
val () =
println!
  ("patsolve_smt2_input: ...")
*)
//
val () = !the_state.input := 1
val () = !the_state.println := 0
val () = !the_state.printfile := 0
//
} (* end of [patsolve_smt2_input] *)

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

implement
patsolve_smt2_output
  (knd) =
{
//
(*
val () =
println!
  ("patsolve_smt2_output: ...")
*)
//
val () = !the_state.input := 0
val () = !the_state.output := 1
val () = !the_state.println := 0
val () = !the_state.printfile := 0
//
val () =
(
  ifcase
    | knd = 1 => !the_state.outfil_mod := file_mode_w
    | knd = 2 => !the_state.outfil_mod := file_mode_a
    | _(* else *) => ()
) : void // end of [val]
//
} (* end of [patsolve_smt2_output] *)

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

implement
patsolve_smt2_println
  ((*void*)) =
{
//
(*
val () =
println!
  ("patsolve_smt2_print: ...")
*)
//
val () = !the_state.input := 0
val () = !the_state.println := 1
val () = !the_state.printfile := 0
//
} (* end of [patsolve_smt2_print] *)

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

implement
patsolve_smt2_printfile
  ((*void*)) =
{
//
(*
val () =
println!
  ("patsolve_smt2_print: ...")
*)
//
val () = !the_state.input := 0
val () = !the_state.println := 0
val () = !the_state.printfile := 1
//
} (* end of [patsolve_smt2_print] *)

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

implement
patsolve_smt2_gitem(arg) = let
//
(*
val () =
println!
(
  "patsolve_smt2_gitem: arg = ", arg
) (* println! *)
*)
//
macdef
input() = (!the_state.input > 0)
macdef
output() = (!the_state.output > 0)
macdef
println() = (!the_state.println > 0)
macdef
printfile() = (!the_state.printfile > 0)
//
in
//
case+ 0 of
//
| _ when input() =>
  {
    val () = patsolve_smt2_input_arg(arg)
    val () =
    (
      !the_state.ninput := !the_state.ninput+1
    )
  } (* input() *)
| _ when output() =>
  {
    val () = !the_state.output := 0
    val () = patsolve_smt2_output_arg(arg)
  } (* input() *)
//
| _ when println() =>
  {
    val () =
      fprintln! (!the_state.outfil_ref, arg)
    // end of [val]
  } (* input() *)
//
| _ when printfile() =>
  {
    val () = patsolve_smt2_printfile_arg(arg)
  } (* input() *)
//
| _ when
    arg = "--real-on" =>
  {
    val () = !the_state.constraint_real := 1
  }
| _ when
    arg = "--real-off" =>
  {
    val () = !the_state.constraint_real := 0
  }
//
| _ (* unrecognized *) => ((*void*))
//
end (* end of [patsolve_smt2_gitem] *)

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

local

fun
auxmain
  (path: string): void = let
//
val
opt =
fileref_open_opt(path, file_mode_r)
//
in
//
case+ opt of
| ~Some_vt(filr) =>
  {
//
    val c3t0 =
      parse_fileref_constraints(filr)
    // end of [val]
    val ((*void*)) = fileref_close(filr)
//
(*
    val () =
    fprint! (
      stdout_ref
    , "patsolve_smt2_input_arg: c3t0 =\n"
    ) (* end of [fprint] *)
    val () =
      fpprint_c3nstr(stdout_ref, c3t0)
    // end of [val]
    val () = fprint_newline (stdout_ref)
*)
//
    val out = !the_state.outfil_ref
    val ((*void*)) = c3nstr_smt2_solve(out, c3t0)
//
  } (* end of [Some_vt] *)
//
| ~None_vt((*void*)) =>
  {
//
(*
    val () = !the_state.inpfil_ref := stdin_ref
*)
//
    val () =
    prerrln!
      ("The file [", path, "] cannot be opened for read!")
    // end of [val]
//
  } (* end of [None_vt] *)
//
end // end of [auxmain]

in (* in-of-local *)
//
implement
patsolve_smt2_input_arg
  (path) =
(
//
case+
path of
| "-" =>
  {
    val inp = stdin_ref
    val out = !the_state.outfil_ref
    val c3t0 = parse_fileref_constraints(inp)
    val ((*void*)) = c3nstr_smt2_solve(out, c3t0)
  }
| _(* ... *) => auxmain(path)
//
) (* end of [patsolve_smt2_input_arg] *)
//
end // end of [local]

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

implement
patsolve_smt2_output_arg
  (path) = let
//
val n1 = !the_state.fopen_out
val f1 = !the_state.outfil_ref
val () = if n1 > 0 then fileref_close(f1)
//
val fm = !the_state.outfil_mod
val opt = fileref_open_opt(path, fm)
//
in
//
case+ opt of
| ~Some_vt(filr) =>
  {
//
    val () = !the_state.fopen_out := 1
    val () = !the_state.outfil_ref := filr
//
  } (* end of [Some_vt] *)
//
| ~None_vt((*void*)) =>
  {
//
    val () = !the_state.fopen_out := 0
    val () = !the_state.outfil_ref := stderr_ref
//
    val () =
    prerrln!
      ("The file [", path, "] cannot be opened for write!")
    // end of [val]
//
  } (* end of [None_vt] *)
//
end // end of [patsolve_smt2_output_arg]

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

implement
patsolve_smt2_printfile_arg
  (path) = let
//
val fm = file_mode_r
val opt =
  fileref_open_opt(path, fm)
//
val out = !the_state.outfil_ref
//
fun
fcopy
(
  inp: FILEref, out: FILEref
) : void = let
//
val iseof = fileref_is_eof(inp)
//
in
//
if
iseof
then
  fileref_close(inp)
else let
//
val str =
  fileref_get_line_string(inp)
// end of [va]
val ((*void*)) = fprintln! (out, str)
val ((*freed*)) = strptr_free(str)
//
in
  fcopy(inp, out)
end (* end of [else] *)
//
end // end of [fcopy]
//
in
//
case+ opt of
| ~Some_vt(inp) =>
    fcopy(inp, out)
  // end of [Some_vt]
| ~None_vt((*void*)) =>
  (
    fprintln! (out, "(the-file-[", path, "]-cannot-open-for-read)")
  ) (* end of [None_vt] *)
//
end // end of [patsolve_smt2_printfile_arg]

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

implement
patsolve_smt2_argend
  ((*void*)) = let
//
macdef test() =
  (!the_state.input > 0 && !the_state.ninput = 0)
//
in
//
case+ 0 of
| _ when test() =>
  {
//
    val inp = stdin_ref
    val out = !the_state.outfil_ref
    val c3t0 = parse_fileref_constraints(inp)
    val ((*void*)) = c3nstr_smt2_solve(out, c3t0)
//
  } (* end of [test] *)
| _ (*rest*) => ((*ignored*))
//
end (* end of [patsolve_smt2_argend] *)

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

implement
patsolve_smt2_commarglst_finalize
  ((*void*)) =
{
//
  val n1 = !the_state.fopen_out
  val f1 = !the_state.outfil_ref
  val () = if n1 > 0 then fileref_close(f1)
//
} (* end of [patsolve_smt2_commarglst_finalize] *)

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

(* end of [patsolve_smt2_commarg.dats] *)

(*
##
## ATS-extsolve-smt2:
## Outputing ATS-constraints
## in the format of smt-lib2
##
*)

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

(*
//
** Author: Hongwei Xi
** Authoremail: gmhwxiATgmailDOTcom
** Start time: June, 2016
//
** Author: William Blair
** Authoremail: wdblairATgmailDOTcom
** Start time: Some time in 2015
//
*)

(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
staload
STDIO = "libc/SATS/stdio.sats"
//
(* ****** ****** *)
//
#define
PATSOLVE_targetloc "./.ATS-extsolve"
//
staload "{$PATSOLVE}/patsolve_cnstrnt.sats"
staload "{$PATSOLVE}/patsolve_parsing.sats"
//
(* ****** ****** *)

staload "./patsolve_smt2_commarg.sats"
staload "./patsolve_smt2_solving.sats"

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

implement
fprint_commarg(out, ca) = (
//
case+ ca of
//
| CAhelp(str) =>
    fprint! (out, "CAhelp(", str, ")")
//
| CAgitem(str) =>
    fprint! (out, "CAgitem(", str, ")")
//
| CAinput(str) =>
    fprint! (out, "CAinput(", str, ")")
//
| CAoutput(knd, str) =>
    fprint! (out, "CAoutput(", knd, ", ", str, ")")
//
| CAprintln(str) =>
    fprint! (out, "CAprintln(", str, ")")
| CAprintfile(str) =>
    fprint! (out, "CAprintfile(", str, ")")
//
| CAargend((*void*)) => fprint! (out, "CAargend(", ")")
//
) (* end of [fprint_commarg] *)

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

fun{
} argv_getopt_at
  {n:int}{i:nat}
(
  n: int n, argv: !argv(n), i: int i
) : stropt =
(
//
if i < n
  then stropt_some (argv[i]) else stropt_none ()
// end of [if]
//
) (* end of [argv_getopt_at] *)

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

implement
patsolve_smt2_cmdline
  (argc, argv) = let
//
vtypedef
res_vt = commarglst_vt
//
fun
aux
{n:int}
{i:nat | i <= n}
(
  argc: int n
, argv: !argv(n)
, i: int i, res0: res_vt
) : res_vt = let
in
//
if
i < argc
then let
//
val arg = argv[i]
//
in
//
case+ arg of
//
| "-h" => let
    val ca =
      CAhelp(arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux(argc, argv, i+1, res0)
  end // end of ...
| "--help" => let
    val ca =
      CAhelp(arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux(argc, argv, i+1, res0)
  end // end of ...
//
| "-i" => let
    val ca =
      CAinput(arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux2(argc, argv, i+1, res0)
  end // end of ...
| "--input" => let
    val ca =
      CAinput(arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux2(argc, argv, i+1, res0)
  end // end of ...
//
| "-o" => let
    val ca =
      CAoutput(0, arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux2(argc, argv, i+1, res0)
  end // end of ...
| "--output" => let
    val ca =
      CAoutput(0, arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux2(argc, argv, i+1, res0)
  end // end of ...
| "--output-w" => let
    val ca =
      CAoutput(1, arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux2(argc, argv, i+1, res0)
  end // end of ...
| "--output-a" => let
    val ca =
      CAoutput(2, arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux2(argc, argv, i+1, res0)
  end // end of ...
//
| "--println" => let
    val ca =
      CAprintln(arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux2(argc, argv, i+1, res0)
  end // end of ...
//
| "--printfile" => let
    val ca =
      CAprintfile(arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux2(argc, argv, i+1, res0)
  end // end of ...
//
| _ (*rest*) => let
    val ca =
      CAgitem(arg)
    val res0 =
      cons_vt(ca, res0)
    // end of [val]
  in
    aux(argc, argv, i+1, res0)
  end // end of [...]
//
end // end of [then]
else res0 // end of [else]
//
end // end of [aux]
//
and
aux2
{n:int}
{i:nat | i <= n}
(
  argc: int n
, argv: !argv(n)
, i: int i, res0: res_vt
) : res_vt = let
in
if
i < argc
then let
//
val arg = argv[i]
//
val ca =
  CAgitem(arg)
val res0 =
  cons_vt(ca, res0)
// end of [val]
in
  aux(argc, argv, i+1, res0)
end // end of [then]
else res0 // end of [else]
//
end // end of [aux2]
//
val args = aux(argc, argv, 0, nil_vt)
//
in
//
list_vt_reverse(list_vt_cons(CAargend(), args))
//
end // end of [patsolve_smt2_cmdline]

(* ****** ****** *)
//
extern fun patsolve_smt2_help(): void
//
extern fun patsolve_smt2_gitem(string): void
//
extern fun patsolve_smt2_input((*void*)): void
extern fun patsolve_smt2_input_arg(string): void
//
extern fun patsolve_smt2_output(knd: int): void
extern fun patsolve_smt2_output_arg(string): void
//
extern fun patsolve_smt2_println(): void
extern fun patsolve_smt2_printfile(): void
extern fun patsolve_smt2_printfile_arg(string): void
//
extern fun patsolve_smt2_argend((*void*)): void
//
extern fun patsolve_smt2_commarglst_finalize(): void
//
(* ****** ****** *)

typedef
state_struct =
@{
//
  nerr= int
//
, input= int
//
, ninput= int
//
, inpfil_ref= FILEref
//
, output= int
//
, fopen_out= int
, outfil_ref= FILEref
, outfil_mod= file_mode
//
, println= int
, printfile= int
//
, constraint_real= int
//
} (* end of [state_struct] *)

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

local
//
var
the_state: state_struct?
//
val () = the_state.nerr := 0
//
val () = the_state.input := 0
val () = the_state.ninput := 0
//
val () = the_state.inpfil_ref := stdin_ref
//
val () = the_state.output := 0
//
val () = the_state.fopen_out := 0
val () = the_state.outfil_ref := stdout_ref
val () = the_state.outfil_mod := file_mode_w
//
val () = the_state.println := 0
val () = the_state.printfile := 0
//
val () = the_state.constraint_real := 0
//
in (* in-of-local *)
//
val
the_state
  : ref(state_struct) =
  ref_make_viewptr(view@the_state | addr@the_state)
//
end // end of [local]

(* ****** ****** *)
//
implement
the_constraint_real
  ((*void*)) = !the_state.constraint_real
//
(* ****** ****** *)

fun
process_arg
  (x: commarg): void = let
//
(*
val () =
fprintln!
(
  stdout_ref
, "patsolve_smt2_commarglst: process_arg: x = ", x
) (* end of [val] *)
*)
//
in
//
case+ x of
//
| CAhelp _ => patsolve_smt2_help()
//
| CAgitem
    (str) => patsolve_smt2_gitem(str)
  // CAgitem
//
| CAinput _ => patsolve_smt2_input()
//
| CAoutput
    (knd, _) => patsolve_smt2_output(knd)
  // CAoutput
//
| CAprintln _ => patsolve_smt2_println()
| CAprintfile _ => patsolve_smt2_printfile()
//
| CAargend((*void*)) => patsolve_smt2_argend()
//
end // end of [process_arg]

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

implement
patsolve_smt2_commarglst
  (xs) = let
(*
val () = println! ("patsolve_smt2_commarglst")
*)
in
//
case+ xs of
| ~list_vt_cons
    (x, xs) => let
    val () = process_arg(x)
  in
    patsolve_smt2_commarglst (xs)
  end // end of [list_vt_cons]
//
| ~list_vt_nil
    ((*void*)) => patsolve_smt2_commarglst_finalize ()
  // end of [list_vt_nil]
//
end // end of [patsolve_smt2_commarglst]

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

implement
patsolve_smt2_help() = let
//
val out = stdout_ref
val cmdname = "patsolve_smt2"
//
in
//
fprintln!
  (out, "Usage: ", cmdname, " <command> ... <command>\n");
fprintln!
  (out, "where a <command> is of one of the following forms:\n");
//
fprintln! (out, "  -h (for printing out this help usage)");
fprintln! (out, "  -i <filename> (input from <filename>)");
fprintln! (out, "  -o <filename> (output into <filename>)");
//
fprintln! (out);
//
fprintln! (out, "  --help (for printing out this help usage)");
//
fprintln! (out, "  --input <filename> (input from <filename>)");
//
fprintln! (out, "  --output <filename> (output into <filename>)");
fprintln! (out, "  --output-w <filename> (output-write into <filename>)");
fprintln! (out, "  --output-a <filename> (output-append into <filename>)");
//
fprintln! (out, "  --println <string> (print <string>+newline)");
fprintln! (out, "  --printfile <filename> (print the content of <filename>)");
//
fprintln! (out);
//
end (* end of [patsolve_smt2_help] *)

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

implement
patsolve_smt2_input() =
{
//
(*
val () =
println!
  ("patsolve_smt2_input: ...")
*)
//
val () = !the_state.input := 1
val () = !the_state.println := 0
val () = !the_state.printfile := 0
//
} (* end of [patsolve_smt2_input] *)

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

implement
patsolve_smt2_output
  (knd) =
{
//
(*
val () =
println!
  ("patsolve_smt2_output: ...")
*)
//
val () = !the_state.input := 0
val () = !the_state.output := 1
val () = !the_state.println := 0
val () = !the_state.printfile := 0
//
val () =
(
  ifcase
    | knd = 1 => !the_state.outfil_mod := file_mode_w
    | knd = 2 => !the_state.outfil_mod := file_mode_a
    | _(* else *) => ()
) : void // end of [val]
//
} (* end of [patsolve_smt2_output] *)

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

implement
patsolve_smt2_println
  ((*void*)) =
{
//
(*
val () =
println!
  ("patsolve_smt2_print: ...")
*)
//
val () = !the_state.input := 0
val () = !the_state.println := 1
val () = !the_state.printfile := 0
//
} (* end of [patsolve_smt2_print] *)

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

implement
patsolve_smt2_printfile
  ((*void*)) =
{
//
(*
val () =
println!
  ("patsolve_smt2_print: ...")
*)
//
val () = !the_state.input := 0
val () = !the_state.println := 0
val () = !the_state.printfile := 1
//
} (* end of [patsolve_smt2_print] *)

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

implement
patsolve_smt2_gitem(arg) = let
//
(*
val () =
println!
(
  "patsolve_smt2_gitem: arg = ", arg
) (* println! *)
*)
//
macdef
input() = (!the_state.input > 0)
macdef
output() = (!the_state.output > 0)
macdef
println() = (!the_state.println > 0)
macdef
printfile() = (!the_state.printfile > 0)
//
in
//
case+ 0 of
//
| _ when input() =>
  {
    val () = patsolve_smt2_input_arg(arg)
    val () =
    (
      !the_state.ninput := !the_state.ninput+1
    )
  } (* input() *)
| _ when output() =>
  {
    val () = !the_state.output := 0
    val () = patsolve_smt2_output_arg(arg)
  } (* input() *)
//
| _ when println() =>
  {
    val () =
      fprintln! (!the_state.outfil_ref, arg)
    // end of [val]
  } (* input() *)
//
| _ when printfile() =>
  {
    val () = patsolve_smt2_printfile_arg(arg)
  } (* input() *)
//
| _ when
    arg = "--real-on" =>
  {
    val () = !the_state.constraint_real := 1
  }
| _ when
    arg = "--real-off" =>
  {
    val () = !the_state.constraint_real := 0
  }
//
| _ (* unrecognized *) => ((*void*))
//
end (* end of [patsolve_smt2_gitem] *)

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

local

fun
auxmain
  (path: string): void = let
//
val
opt =
fileref_open_opt(path, file_mode_r)
//
in
//
case+ opt of
| ~Some_vt(filr) =>
  {
//
    val c3t0 =
      parse_fileref_constraints(filr)
    // end of [val]
    val ((*void*)) = fileref_close(filr)
//
(*
    val () =
    fprint! (
      stdout_ref
    , "patsolve_smt2_input_arg: c3t0 =\n"
    ) (* end of [fprint] *)
    val () =
      fpprint_c3nstr(stdout_ref, c3t0)
    // end of [val]
    val () = fprint_newline (stdout_ref)
*)
//
    val out = !the_state.outfil_ref
    val ((*void*)) = c3nstr_smt2_solve(out, c3t0)
//
  } (* end of [Some_vt] *)
//
| ~None_vt((*void*)) =>
  {
//
(*
    val () = !the_state.inpfil_ref := stdin_ref
*)
//
    val () =
    prerrln!
      ("The file [", path, "] cannot be opened for read!")
    // end of [val]
//
  } (* end of [None_vt] *)
//
end // end of [auxmain]

in (* in-of-local *)
//
implement
patsolve_smt2_input_arg
  (path) =
(
//
case+
path of
| "-" =>
  {
    val inp = stdin_ref
    val out = !the_state.outfil_ref
    val c3t0 = parse_fileref_constraints(inp)
    val ((*void*)) = c3nstr_smt2_solve(out, c3t0)
  }
| _(* ... *) => auxmain(path)
//
) (* end of [patsolve_smt2_input_arg] *)
//
end // end of [local]

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

implement
patsolve_smt2_output_arg
  (path) = let
//
val n1 = !the_state.fopen_out
val f1 = !the_state.outfil_ref
val () = if n1 > 0 then fileref_close(f1)
//
val fm = !the_state.outfil_mod
val opt = fileref_open_opt(path, fm)
//
in
//
case+ opt of
| ~Some_vt(filr) =>
  {
//
    val () = !the_state.fopen_out := 1
    val () = !the_state.outfil_ref := filr
//
  } (* end of [Some_vt] *)
//
| ~None_vt((*void*)) =>
  {
//
    val () = !the_state.fopen_out := 0
    val () = !the_state.outfil_ref := stderr_ref
//
    val () =
    prerrln!
      ("The file [", path, "] cannot be opened for write!")
    // end of [val]
//
  } (* end of [None_vt] *)
//
end // end of [patsolve_smt2_output_arg]

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

implement
patsolve_smt2_printfile_arg
  (path) = let
//
val fm = file_mode_r
val opt =
  fileref_open_opt(path, fm)
//
val out = !the_state.outfil_ref
//
fun
fcopy
(
  inp: FILEref, out: FILEref
) : void = let
//
val iseof = fileref_is_eof(inp)
//
in
//
if
iseof
then
  fileref_close(inp)
else let
//
val str =
  fileref_get_line_string(inp)
// end of [va]
val ((*void*)) = fprintln! (out, str)
val ((*freed*)) = strptr_free(str)
//
in
  fcopy(inp, out)
end (* end of [else] *)
//
end // end of [fcopy]
//
in
//
case+ opt of
| ~Some_vt(inp) =>
    fcopy(inp, out)
  // end of [Some_vt]
| ~None_vt((*void*)) =>
  (
    fprintln! (out, "(the-file-[", path, "]-cannot-open-for-read)")
  ) (* end of [None_vt] *)
//
end // end of [patsolve_smt2_printfile_arg]

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

implement
patsolve_smt2_argend
  ((*void*)) = let
//
macdef test() =
  (!the_state.input > 0 && !the_state.ninput = 0)
//
in
//
case+ 0 of
| _ when test() =>
  {
//
    val inp = stdin_ref
    val out = !the_state.outfil_ref
    val c3t0 = parse_fileref_constraints(inp)
    val ((*void*)) = c3nstr_smt2_solve(out, c3t0)
//
  } (* end of [test] *)
| _ (*rest*) => ((*ignored*))
//
end (* end of [patsolve_smt2_argend] *)

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

implement
patsolve_smt2_commarglst_finalize
  ((*void*)) =
{
//
  val n1 = !the_state.fopen_out
  val f1 = !the_state.outfil_ref
  val () = if n1 > 0 then fileref_close(f1)
//
} (* end of [patsolve_smt2_commarglst_finalize] *)

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

(* end of [patsolve_smt2_commarg.dats] *)