%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2018, 2020-2024 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% This module dumps out MLDS code in a form designed to help debug
% MLDS code generation and optimization, by making MLDS code fragments
% as easy to understand as possible. To this end, the output generated
% by this module
%
% - intentionally omits details that are only rarely relevant during
%   such debugging, and
%
% - presents the remaining details in a very direct, simple and unambiguous
%   format that is not constrained by the syntax of any actual programming
%   language.
%
%---------------------------------------------------------------------------%

:- module ml_backend.mlds_dump.
:- interface.

:- import_module ml_backend.mlds.

:- import_module io.

:- pred dump_mlds_stmt(io.text_output_stream::in, int::in, mlds_stmt::in,
    io::di, io::uo) is det.

%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

:- implementation.

:- import_module backend_libs.
:- import_module backend_libs.builtin_ops.
:- import_module hlds.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_pred.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.

:- import_module bool.
:- import_module cord.
:- import_module int.
:- import_module list.
:- import_module maybe.
:- import_module require.
:- import_module string.
:- import_module term.
:- import_module uint8.

%---------------------------------------------------------------------------%

:- type strcord == cord(string).

:- func strcord_to_string(strcord) = string.

strcord_to_string(Cord) = string.append_list(cord.to_list(Cord)).

%---------------------------------------------------------------------------%

dump_mlds_stmt(Stream, Indent, Stmt, !IO) :-
    Cord = mlds_stmt_to_strcord(Indent, Stmt),
    io.write_string(Stream, strcord_to_string(Cord), !IO).

%---------------------------------------------------------------------------%

:- func mlds_stmts_to_strcord(int, list(mlds_stmt)) = strcord.

mlds_stmts_to_strcord(_Indent, []) = cord.init.
mlds_stmts_to_strcord(Indent, [Stmt | Stmts]) =
    mlds_stmt_to_strcord(Indent, Stmt) ++
    mlds_stmts_to_strcord(Indent, Stmts).

:- func mlds_stmt_to_strcord(int, mlds_stmt) = strcord.

mlds_stmt_to_strcord(Indent, Stmt) = Cord :-
    (
        Stmt = ml_stmt_block(LocalVarDefns, FuncDefns, SubStmts, _Context),
        (
            LocalVarDefns = [],
            LocalVarsCord = cord.init
        ;
            LocalVarDefns = [_ | _],
            LocalVarsCord =
                mlds_local_var_defns_to_strcord(Indent + 1, LocalVarDefns) ++
                nl_strcord
        ),
        (
            FuncDefns = [],
            FuncsCord = cord.init
        ;
            FuncDefns = [_ | _],
            FuncsCord =
                mlds_function_defns_to_strcord(Indent + 1, FuncDefns) ++
                nl_strcord
        ),
        Cord =
            indent_strcord(Indent) ++ strcord("block start\n") ++
            LocalVarsCord ++
            FuncsCord ++
            mlds_stmts_to_strcord(Indent + 1, SubStmts) ++
            indent_strcord(Indent) ++ strcord("block end\n")
    ;
        Stmt = ml_stmt_while(Kind, Rval, SubStmt, LocalLoopVars, _Context),
        (
            LocalLoopVars = [],
            LocalLoopVarsCord = cord.init
        ;
            LocalLoopVars = [_ | _],
            LocalLoopVarsCord =
                indent_strcord(Indent) ++ strcord("loop local vars ") ++
                strcord(string.join_list(", ",
                    list.map(ml_local_var_name_to_string, LocalLoopVars))) ++
                nl_strcord
        ),
        (
            Kind = may_loop_zero_times,
            Cord =
                indent_strcord(Indent) ++ strcord("while ") ++
                    mlds_rval_to_strcord(Rval) ++ nl_strcord ++
                mlds_stmt_to_strcord(Indent + 1, SubStmt) ++
                indent_strcord(Indent) ++ strcord("end while\n") ++
                LocalLoopVarsCord
        ;
            Kind = loop_at_least_once,
            Cord =
                indent_strcord(Indent) ++ strcord("do\n") ++
                mlds_stmt_to_strcord(Indent + 1, SubStmt) ++
                indent_strcord(Indent) ++ strcord("while ") ++
                    mlds_rval_to_strcord(Rval) ++ nl_strcord ++
                LocalLoopVarsCord
        )
    ;
        Stmt = ml_stmt_if_then_else(Cond, Then, MaybeElse, _Context),
        (
            MaybeElse = yes(Else),
            Cord =
                indent_strcord(Indent) ++ strcord("if ") ++
                    mlds_rval_to_strcord(Cond) ++ nl_strcord ++
                indent_strcord(Indent) ++ strcord("then\n") ++
                mlds_stmt_to_strcord(Indent + 1, Then) ++
                indent_strcord(Indent) ++ strcord("else\n") ++
                mlds_stmt_to_strcord(Indent + 1, Else) ++
                indent_strcord(Indent) ++ strcord("end if\n")
        ;
            MaybeElse = no,
            Cord =
                indent_strcord(Indent) ++ strcord("if ") ++
                    mlds_rval_to_strcord(Cond) ++ nl_strcord ++
                indent_strcord(Indent) ++ strcord("then\n") ++
                mlds_stmt_to_strcord(Indent + 1, Then) ++
                indent_strcord(Indent) ++ strcord("end if\n")
        )
    ;
        Stmt = ml_stmt_switch(Type, Rval, Range, Cases, Default, _Context),
        (
            Range = mlds_switch_range_unknown,
            RangeCord = cord.init
        ;
            Range = mlds_switch_range(Min, Max),
            RangeCord =
                strcord(" from ") ++ intcord(Min) ++
                strcord(" to ") ++ intcord(Max)
        ),
        Cord =
            indent_strcord(Indent) ++ strcord("switch ") ++
                strcord("(") ++ mlds_rval_to_strcord(Rval) ++ strcord(")") ++
                mlds_type_to_strcord(Type) ++ RangeCord ++ nl_strcord ++
            cord_list_to_cord(
                list.map(mlds_switch_case_to_strcord(Indent + 1), Cases)) ++
            mlds_switch_default_to_strcord(Indent + 1, Default) ++
            indent_strcord(Indent) ++ strcord("end switch\n")
    ;
        Stmt = ml_stmt_label(mlds_label(LabelName), _Context),
        Cord =
            indent_strcord(Indent) ++ strcord("label ") ++
                strcord(LabelName) ++ nl_strcord
    ;
        Stmt = ml_stmt_goto(Target, _Context),
        Cord =
            indent_strcord(Indent) ++ strcord("goto ") ++
                mlds_goto_target_to_strcord(Target) ++ nl_strcord
    ;
        Stmt = ml_stmt_computed_goto(Rval, Labels, _Context),
        Cord =
            indent_strcord(Indent) ++ strcord("computed goto ") ++
                strcord("(") ++ mlds_rval_to_strcord(Rval) ++ strcord(")") ++
                nl_strcord ++
                mlds_computed_goto_labels_to_strcord(Indent, 0, Labels)
    ;
        Stmt = ml_stmt_call(_Sig, FuncRval, ArgRvals, RetLvals, TailCall,
            _Context),
        (
            TailCall = no_return_call,
            CallCord = strcord("no_return_call ")
        ;
            TailCall = tail_call,
            CallCord = strcord("tail_call ")
        ;
            TailCall = ordinary_call,
            CallCord = strcord("call ")
        ),
        (
            ArgRvals = [],
            ArgsCord = cord.init
        ;
            ArgRvals = [HeadArgRval | TailArgRvals],
            ArgsCord = strcord("(") ++
                mlds_rvals_to_strcord(HeadArgRval, TailArgRvals) ++
                strcord(")")
        ),
        (
            RetLvals = [],
            RetCord = cord.init
        ;
            RetLvals = [HeadRetLval | TailRetLvals],
            RetCord = strcord(" -> (") ++
                mlds_lvals_to_strcord(HeadRetLval, TailRetLvals) ++
                strcord(")")
        ),
        Cord =
            indent_strcord(Indent) ++ CallCord ++
                mlds_rval_to_strcord(FuncRval) ++ ArgsCord ++ RetCord
    ;
        Stmt = ml_stmt_return(Rvals, _Context),
        (
            Rvals = [],
            Cord =
                indent_strcord(Indent) ++ strcord("return")
        ;
            Rvals = [HeadRval | TailRvals],
            Cord =
                indent_strcord(Indent) ++ strcord("return ") ++
                    mlds_rvals_to_strcord(HeadRval, TailRvals)
        )
    ;
        Stmt = ml_stmt_try_commit(RefLval, BodyStmt, HandlerStmt, _Context),
        Cord =
            indent_strcord(Indent) ++ strcord("try_commit ") ++
                mlds_lval_to_strcord(RefLval) ++ nl_strcord ++
            indent_strcord(Indent) ++ strcord("stmt to try\n") ++
            mlds_stmt_to_strcord(Indent + 1, BodyStmt) ++
            indent_strcord(Indent) ++ strcord("commit handler stmt\n") ++
            mlds_stmt_to_strcord(Indent + 1, HandlerStmt) ++
            indent_strcord(Indent) ++ strcord("end_try_commit\n")
    ;
        Stmt = ml_stmt_do_commit(RefRval, _Context),
        Cord =
            indent_strcord(Indent) ++ strcord("do_commit ") ++
                mlds_rval_to_strcord(RefRval)
    ;
        Stmt = ml_stmt_atomic(AtomicStmt, _Context),
        Cord = mlds_atomic_stmt_to_strcord(Indent, AtomicStmt)
    ).

:- func mlds_switch_case_to_strcord(int, mlds_switch_case) = strcord.

mlds_switch_case_to_strcord(Indent, Case) = Cord :-
    Case = mlds_switch_case(FirstCond, LaterConds, Stmt),
    Cord =
        mlds_case_match_cond_to_strcord(Indent, FirstCond) ++
        cord_list_to_cord(
            list.map(mlds_case_match_cond_to_strcord(Indent), LaterConds)) ++
        mlds_stmt_to_strcord(Indent + 1, Stmt).

:- func mlds_case_match_cond_to_strcord(int, mlds_case_match_cond) = strcord.

mlds_case_match_cond_to_strcord(Indent, Cond) = Cord :-
    (
        Cond = match_value(Rval),
        Cord =
            indent_strcord(Indent) ++ strcord("match value ") ++
                mlds_rval_to_strcord(Rval) ++ nl_strcord
    ;
        Cond = match_range(MinRval, MaxRval),
        Cord =
            indent_strcord(Indent) ++ strcord("match range ") ++
                mlds_rval_to_strcord(MinRval) ++ strcord(" to ") ++
                mlds_rval_to_strcord(MaxRval) ++ nl_strcord
    ).

:- func mlds_switch_default_to_strcord(int, mlds_switch_default) = strcord.

mlds_switch_default_to_strcord(Indent, Default) = Cord :-
    (
        Default = default_is_unreachable,
        Cord = indent_strcord(Indent) ++ strcord("default is unreachable\n")
    ;
        Default = default_do_nothing,
        Cord = indent_strcord(Indent) ++ strcord("default is do nothing\n")
    ;
        Default = default_case(Stmt),
        Cord =
            indent_strcord(Indent) ++ strcord("default statement:\n") ++
            mlds_stmt_to_strcord(Indent + 1, Stmt)
    ).

:- func mlds_goto_target_to_strcord(mlds_goto_target) = strcord.

mlds_goto_target_to_strcord(Target) = Cord :-
    (
        Target = goto_label(mlds_label(LabelName)),
        Cord = strcord(LabelName)
    ;
        Target = goto_break_switch,
        Cord = strcord("break_switch")
    ;
        Target = goto_break_loop,
        Cord = strcord("break_loop")
    ;
        Target = goto_continue_loop,
        Cord = strcord("continue_loop")
    ).

:- func mlds_computed_goto_labels_to_strcord(int, int, list(mlds_label))
    = strcord.

mlds_computed_goto_labels_to_strcord(_Indent, _Index, []) = cord.init.
mlds_computed_goto_labels_to_strcord(Indent, Index,
        [mlds_label(LabelName) | Labels]) =
    indent_strcord(Indent) ++ intcord(Index) ++ strcord(": ") ++
        strcord(LabelName) ++ nl_strcord ++
    mlds_computed_goto_labels_to_strcord(Indent, Index + 1, Labels).

:- func mlds_atomic_stmt_to_strcord(int, mlds_atomic_statement) = strcord.

mlds_atomic_stmt_to_strcord(Indent, AtomicStmt) = Cord :-
    (
        AtomicStmt = comment(Comment0),
        string.replace_all(Comment0, "\n", " ", Comment),
        Cord = indent_strcord(Indent) ++ strcord(Comment) ++ nl_strcord
    ;
        AtomicStmt = gc_check,
        Cord = indent_strcord(Indent) ++ strcord("gc_check\n")
    ;
        AtomicStmt = assign(Lval, Rval),
        Cord =
            indent_strcord(Indent) ++ mlds_lval_to_strcord(Lval) ++
                strcord(" := ") ++ mlds_rval_to_strcord(Rval) ++ nl_strcord
    ;
        AtomicStmt = assign_if_in_heap(Lval, Rval),
        Cord =
            indent_strcord(Indent) ++ mlds_lval_to_strcord(Lval) ++
                strcord(" ?:= ") ++ mlds_rval_to_strcord(Rval) ++ nl_strcord
    ;
        AtomicStmt = delete_object(Rval),
        Cord =
            indent_strcord(Indent) ++ strcord("delete object ") ++
                mlds_rval_to_strcord(Rval) ++ nl_strcord
    ;
        AtomicStmt = new_object(Target, Ptag, ExplicitSecTag, Type,
            MaybeSize, _MaybeCtorName, _ArgRvalsTypes, _MayUseAtomic,
            _MaybeAllocId),
        (
            ExplicitSecTag = no,
            SecTagCord = strcord("no explicit sectag")
        ;
            ExplicitSecTag = yes,
            SecTagCord = strcord("explicit sectag")
        ),
        (
            MaybeSize = no,
            SizeCord = strcord("no size")
        ;
            MaybeSize = yes(Size),
            SizeCord = mlds_rval_to_strcord(Size) ++ strcord(" words")
        ),
        Cord =
            indent_strcord(Indent) ++ mlds_lval_to_strcord(Target) ++
                strcord(" := new object(ptag ") ++ ptag_to_strcord(Ptag) ++
                comma_cord ++ SecTagCord ++ comma_cord ++ SizeCord ++
                comma_cord ++ mlds_type_to_strcord(Type) ++ strcord(")") ++
                nl_strcord
    ;
        AtomicStmt = mark_hp(Lval),
        Cord =
            indent_strcord(Indent) ++ strcord("mark_hp ") ++
                mlds_lval_to_strcord(Lval) ++ nl_strcord
    ;
        AtomicStmt = restore_hp(Rval),
        Cord =
            indent_strcord(Indent) ++ strcord("restore_hp ") ++
                mlds_rval_to_strcord(Rval) ++ nl_strcord
    ;
        AtomicStmt = trail_op(TrailOp),
        (
            TrailOp = store_ticket(Lval),
            Cord =
                indent_strcord(Indent) ++ strcord("store_ticket ") ++
                    mlds_lval_to_strcord(Lval) ++ nl_strcord
        ;
            TrailOp = reset_ticket(Rval, Reason),
            (
                Reason = undo,
                ReasonCord = strcord("undo ")
            ;
                Reason = commit,
                ReasonCord = strcord("commit ")
            ;
                Reason = solve,
                ReasonCord = strcord("solve ")
            ;
                Reason = exception,
                ReasonCord = strcord("exception ")
            ;
                Reason = gc,
                ReasonCord = strcord("gc ")
            ),
            Cord =
                indent_strcord(Indent) ++ strcord("reset_ticket for ") ++
                    ReasonCord ++ mlds_rval_to_strcord(Rval) ++ nl_strcord
        ;
            TrailOp = discard_ticket,
            Cord =
                indent_strcord(Indent) ++ strcord("discard_ticket") ++
                    nl_strcord
        ;
            TrailOp = prune_ticket,
            Cord =
                indent_strcord(Indent) ++ strcord("prune_ticket") ++
                    nl_strcord
        ;
            TrailOp = mark_ticket_stack(Lval),
            Cord =
                indent_strcord(Indent) ++ strcord("mark_ticket_stack ") ++
                    mlds_lval_to_strcord(Lval) ++ nl_strcord
        ;
            TrailOp = prune_tickets_to(Rval),
            Cord =
                indent_strcord(Indent) ++ strcord("prune_tickets_to ") ++
                    mlds_rval_to_strcord(Rval) ++ nl_strcord
        )
    ;
        AtomicStmt = inline_target_code(_Lang, Components),
        Cord =
            indent_strcord(Indent) ++ strcord("inline_target_code\n") ++
            cord_list_to_cord(
                list.map(target_code_component_to_strcord(Indent + 1),
                    Components)) ++
            indent_strcord(Indent) ++ strcord("end inline_target_code\n")
    ;
        AtomicStmt = outline_foreign_proc(_Lang, OutlineArgs, ReturnLvals,
            Code),
        (
            ReturnLvals = [],
            ReturnCord =
                indent_strcord(Indent + 1) ++ strcord("no return lvals\n")
        ;
            ReturnLvals = [HeadLval | TailLvals],
            ReturnCord =
                indent_strcord(Indent + 1) ++ strcord("return lvals ") ++
                    mlds_lvals_to_strcord(HeadLval, TailLvals) ++ nl_strcord
        ),
        Cord =
            indent_strcord(Indent) ++ strcord("inline_target_code\n") ++
            cord_list_to_cord(
                list.map(outline_arg_to_strcord(Indent + 1),
                    OutlineArgs)) ++
            ReturnCord ++
            indent_strcord(Indent + 1) ++ strcord("code\n") ++
            strcord(Code) ++
            indent_strcord(Indent) ++ strcord("end inline_target_code\n")
    ).

:- func target_code_component_to_strcord(int, target_code_component) = strcord.

target_code_component_to_strcord(Indent, Component) = Cord :-
    (
        Component = user_target_code(Code, _Context),
        Cord =
            indent_strcord(Indent) ++ strcord("user_target_code") ++
                nl_strcord ++
            strcord(Code) ++ nl_strcord
    ;
        Component = raw_target_code(Code),
        Cord =
            indent_strcord(Indent) ++ strcord("raw_target_code") ++
                nl_strcord ++
            strcord(Code) ++ nl_strcord
    ;
        Component = target_code_input(Rval),
        Cord =
            indent_strcord(Indent) ++ strcord("input ") ++
            mlds_rval_to_strcord(Rval) ++ nl_strcord
    ;
        Component = target_code_output(Lval),
        Cord =
            indent_strcord(Indent) ++ strcord("output ") ++
            mlds_lval_to_strcord(Lval) ++ nl_strcord
    ;
        Component = target_code_type(Type),
        Cord =
            indent_strcord(Indent) ++ strcord("type ") ++
            mlds_type_to_strcord(Type) ++ nl_strcord
    ;
        Component = target_code_function_name(_QualFuncName),
        Cord = cord.init
    ;
        Component = target_code_alloc_id(_AllocId),
        Cord = cord.init
    ).

:- func outline_arg_to_strcord(int, outline_arg) = strcord.

outline_arg_to_strcord(Indent, OutlineArg) = Cord :-
    (
        OutlineArg = ola_in(Type, Name, Rval),
        Cord =
            indent_strcord(Indent) ++ strcord("input ") ++
                mlds_type_to_strcord(Type) ++ strcord(" ") ++
                strcord(Name) ++ strcord(" <= ") ++
                mlds_rval_to_strcord(Rval) ++ nl_strcord
    ;
        OutlineArg = ola_out(Type, Name, Lval),
        Cord =
            indent_strcord(Indent) ++ strcord("output ") ++
                mlds_type_to_strcord(Type) ++ strcord(" ") ++
                strcord(Name) ++ strcord(" => ") ++
                mlds_lval_to_strcord(Lval) ++ nl_strcord
    ;
        OutlineArg = ola_unused,
        Cord =
            indent_strcord(Indent) ++ strcord("unused\n")
    ).

%---------------------------------------------------------------------------%

:- func mlds_lvals_to_strcord(mlds_lval, list(mlds_lval)) = strcord.

mlds_lvals_to_strcord(HeadLval, TailLvals) = Cord :-
    (
        TailLvals = [],
        Cord = mlds_lval_to_strcord(HeadLval)
    ;
        TailLvals = [HeadTailLval | TailTailLvals],
        Cord = mlds_lval_to_strcord(HeadLval) ++ comma_cord ++
            mlds_lvals_to_strcord(HeadTailLval, TailTailLvals)
    ).

:- func mlds_lval_to_strcord(mlds_lval) = strcord.

mlds_lval_to_strcord(Lval) = Cord :-
    (
        Lval = ml_local_var(LocalVar, _Type),
        Cord = strcord(ml_local_var_name_to_string(LocalVar))
    ;
        Lval = ml_global_var(QualGlobalVar, _Type),
        QualGlobalVar = qual_global_var_name(_ModuleName, GlobalVar),
        (
            GlobalVar = gvn_rtti_var(_RttiId),
            Cord = strcord("rtti_id")
        ;
            GlobalVar = gvn_tabling_var(_, _),
            Cord = strcord("tabling_var")
        ;
            GlobalVar = gvn_const_var(GlobalConstVar, SeqNum),
            (
                GlobalConstVar = mgcv_const_var,
                GlobalCord = strcord("global const var ")
            ;
                GlobalConstVar = mgcv_float,
                GlobalCord = strcord("global float var ")
            ;
                GlobalConstVar = mgcv_int64,
                GlobalCord = strcord("global int64 var ")
            ;
                GlobalConstVar = mgcv_uint64,
                GlobalCord = strcord("global uint64 var ")
            ;
                GlobalConstVar = mgcv_closure_layout,
                GlobalCord = strcord("global closure layout ")
            ;
                GlobalConstVar = mgcv_typevar_vector,
                GlobalCord = strcord("global typevar vector ")
            ;
                GlobalConstVar = mgcv_bit_vector,
                GlobalCord = strcord("global bit vector ")
            ),
            Cord = GlobalCord ++ intcord(SeqNum)
        ;
            GlobalVar = gvn_dummy_var,
            Cord = strcord("dummy_var")
        )
    ;
        Lval = ml_target_global_var_ref(GlobalVarRef),
        GlobalVarRef = env_var_ref(EnvVar),
        Cord = strcord("env_var_ref(") ++ strcord(EnvVar) ++ strcord(")")
    ;
        Lval = ml_mem_ref(AddrRval, _Type),
        Cord = strcord("mem_ref(") ++ mlds_rval_to_strcord(AddrRval) ++
            strcord(")")
    ;
        Lval = ml_field(MaybePtag, PtrRval, _PtrType, FieldId, _FieldType),
        (
            MaybePtag = no,
            PtagCord = strcord("ptag unknown")
        ;
            MaybePtag = yes(Ptag),
            PtagCord = strcord("ptag " ) ++ ptag_to_strcord(Ptag)
        ),
        (
            FieldId = ml_field_offset(OffsetRval),
            FieldCord = mlds_rval_to_strcord(OffsetRval)
        ;
            FieldId = ml_field_named(QualVarName, _FieldIdType),
            QualVarName = qual_field_var_name(_ModuleName, _QualKind,
                FieldVarName),
            FieldCord = mlds_field_var_name_to_strcord(FieldVarName)
        ),
        Cord =
            strcord("field(") ++ PtagCord ++ comma_cord ++
            mlds_rval_to_strcord(PtrRval) ++ comma_cord ++
            FieldCord ++ strcord(")")
    ).

%---------------------------------------------------------------------------%

:- func mlds_rvals_to_strcord(mlds_rval, list(mlds_rval)) = strcord.

mlds_rvals_to_strcord(HeadRval, TailRvals) = Cord :-
    (
        TailRvals = [],
        Cord = mlds_rval_to_strcord(HeadRval)
    ;
        TailRvals = [HeadTailRval | TailTailRvals],
        Cord = mlds_rval_to_strcord(HeadRval) ++ comma_cord ++
            mlds_rvals_to_strcord(HeadTailRval, TailTailRvals)
    ).

:- func mlds_rval_to_strcord(mlds_rval) = strcord.

mlds_rval_to_strcord(Rval) = Cord :-
    (
        Rval = ml_lval(Lval),
        Cord = mlds_lval_to_strcord(Lval)
    ;
        Rval = ml_mkword(Ptag, SubRval),
        Cord = strcord("mkword(") ++ ptag_to_strcord(Ptag) ++ comma_cord ++
            mlds_rval_to_strcord(SubRval) ++ strcord(")")
    ;
        Rval = ml_const(RvalConst),
        Cord = mlds_rval_const_to_strcord(RvalConst)
    ;
        Rval = ml_box(FromType, SubRval),
        Cord = strcord("box(from ") ++ mlds_type_to_strcord(FromType) ++
            comma_cord ++ mlds_rval_to_strcord(SubRval) ++ strcord(")")
    ;
        Rval = ml_unbox(ToType, SubRval),
        Cord = strcord("unbox(to ") ++ mlds_type_to_strcord(ToType) ++
            comma_cord ++ mlds_rval_to_strcord(SubRval) ++ strcord(")")
    ;
        Rval = ml_cast(ToType, SubRval),
        Cord = strcord("cast(to ") ++ mlds_type_to_strcord(ToType) ++
            comma_cord ++ mlds_rval_to_strcord(SubRval) ++ strcord(")")
    ;
        Rval = ml_unop(UnOp, SubRvalA),
        Cord = unop_to_strcord(UnOp) ++ strcord("(") ++
            mlds_rval_to_strcord(SubRvalA) ++ strcord(")")
    ;
        Rval = ml_binop(BinOp, SubRvalA, SubRvalB),
        Cord = binop_to_strcord(BinOp) ++ strcord("(") ++
            mlds_rval_to_strcord(SubRvalA) ++ comma_cord ++
            mlds_rval_to_strcord(SubRvalB) ++ strcord(")")
    ;
        Rval = ml_mem_addr(SubLval),
        Cord = strcord("addr_of(") ++ mlds_lval_to_strcord(SubLval) ++
            strcord(")")
    ;
        Rval = ml_scalar_common(ScalarCommon),
        Cord = strcord("scalar_common(") ++
            mlds_scalar_common_to_strcord(ScalarCommon) ++ strcord(")")
    ;
        Rval = ml_scalar_common_addr(ScalarCommon),
        Cord = strcord("scalar_common_addr(") ++
            mlds_scalar_common_to_strcord(ScalarCommon) ++ strcord(")")
    ;
        Rval = ml_vector_common_row_addr(VectorCommon, RowRval),
        Cord = strcord("vector_common_row_addr(") ++
            mlds_vector_common_to_strcord(VectorCommon) ++ comma_cord ++
            mlds_rval_to_strcord(RowRval) ++ strcord(")")
    ;
        Rval = ml_self(_Type),
        Cord = strcord("self")
    ).

:- func ptag_to_strcord(ptag) = strcord.

ptag_to_strcord(Ptag) = Cord :-
    Ptag = ptag(PtagUint8),
    Cord = intcord(uint8.cast_to_int(PtagUint8)).

:- func mlds_rval_const_to_strcord(mlds_rval_const) = strcord.

mlds_rval_const_to_strcord(Const) = Cord :-
    (
        Const = mlconst_true,
        Cord = strcord("true")
    ;
        Const = mlconst_false,
        Cord = strcord("false")
    ;
        Const = mlconst_int(Int),
        Cord = strcord(string.int_to_string(Int))
    ;
        Const = mlconst_uint(Uint),
        Cord = strcord(string.uint_to_string(Uint))
    ;
        Const = mlconst_int8(Int8),
        Cord = strcord(string.int8_to_string(Int8))
    ;
        Const = mlconst_uint8(Uint8),
        Cord = strcord(string.uint8_to_string(Uint8))
    ;
        Const = mlconst_int16(Int16),
        Cord = strcord(string.int16_to_string(Int16))
    ;
        Const = mlconst_uint16(Uint16),
        Cord = strcord(string.uint16_to_string(Uint16))
    ;
        Const = mlconst_int32(Int32),
        Cord = strcord(string.int32_to_string(Int32))
    ;
        Const = mlconst_uint32(Uint32),
        Cord = strcord(string.uint32_to_string(Uint32))
    ;
        Const = mlconst_int64(Int64),
        Cord = strcord(string.int64_to_string(Int64))
    ;
        Const = mlconst_uint64(Uint64),
        Cord = strcord(string.uint64_to_string(Uint64))
    ;
        Const = mlconst_enum(N, Type),
        Cord = strcord("enum(") ++ mlds_type_to_strcord(Type) ++ comma_cord ++
            intcord(N) ++ strcord(")")
    ;
        Const = mlconst_char(Char),
        Cord = strcord("char ") ++ intcord(Char)
    ;
        Const = mlconst_float(Float),
        Cord = strcord(string.float_to_string(Float))
    ;
        Const = mlconst_string(Str),
        Cord = strcord("""") ++ strcord(Str) ++ strcord("""")
    ;
        Const = mlconst_multi_string(_MultiStr),
        Cord = strcord("multi_string")
    ;
        Const = mlconst_foreign(_Lang, Str, _Type),
        Cord = strcord("foreign ") ++ strcord(Str)
    ;
        Const = mlconst_named_const(_TargetPrefixes, Str),
        Cord = strcord("named_const ") ++ strcord(Str)
    ;
        Const = mlconst_code_addr(CodeAddr),
        CodeAddr = mlds_code_addr(QualFuncLabel, _Signature),
        QualFuncLabel = qual_func_label(_ModuleName, FuncLabel),
        FuncLabelCord = mlds_func_label_to_strcord(FuncLabel),
        Cord = strcord("&") ++ FuncLabelCord
    ;
        Const = mlconst_data_addr_local_var(LocalVar),
        Cord = strcord("&") ++ strcord(ml_local_var_name_to_string(LocalVar))
    ;
        Const = mlconst_data_addr_global_var(_ModuleName, _GlobalVar),
        Cord = strcord("&global_var")
    ;
        Const = mlconst_data_addr_rtti(_ModuleName, _RttiId),
        Cord = strcord("&rtti")
    ;
        Const = mlconst_data_addr_tabling(_QualProcLabel, _TablingStructId),
        Cord = strcord("&tabling")
    ;
        Const = mlconst_null(_Type),
        Cord = strcord("null")
    ).

:- func mlds_scalar_common_to_strcord(mlds_scalar_common) = strcord.

mlds_scalar_common_to_strcord(ScalarCommon) = Cord :-
    ScalarCommon = mlds_scalar_common(_ModuleName, _Type, TypeNum, RowNum),
    TypeNum = ml_scalar_common_type_num(TypeNumInt),
    Cord = strcord("scalar_common(type ") ++ intcord(TypeNumInt) ++
        comma_cord ++ strcord("row ") ++ intcord(RowNum) ++ strcord(")").

:- func mlds_vector_common_to_strcord(mlds_vector_common) = strcord.

mlds_vector_common_to_strcord(VectorCommon) = Cord :-
    VectorCommon = mlds_vector_common(_ModuleName, _Type, TypeNum,
        StartRowNum, NumRows),
    TypeNum = ml_vector_common_type_num(TypeNumInt),
    Cord = strcord("vector_common(type ") ++ intcord(TypeNumInt) ++
        comma_cord ++ strcord("start row ") ++ intcord(StartRowNum) ++
        comma_cord ++ strcord("num rows ") ++ intcord(NumRows) ++ strcord(")").

:- func unop_to_strcord(unary_op) = strcord.

unop_to_strcord(UnOp) = Cord :-
    (
        UnOp = tag,
        Cord = strcord("tag")
    ;
        UnOp = strip_tag,
        Cord = strcord("strip_tag")
    ;
        UnOp = mkbody,
        Cord = strcord("mkbody")
    ;
        UnOp = unmkbody,
        Cord = strcord("unmkbody")
    ;
        UnOp = bitwise_complement(IntType),
        Cord = strcord("bitwise_complement<") ++
            int_type_to_strcord(IntType) ++ strcord(">")
    ;
        UnOp = logical_not,
        Cord = strcord("logical_not")
    ;
        UnOp = hash_string,
        Cord = strcord("hash_string1")
    ;
        UnOp = hash_string2,
        Cord = strcord("hash_string2")
    ;
        UnOp = hash_string3,
        Cord = strcord("hash_string3")
    ;
        UnOp = hash_string4,
        Cord = strcord("hash_string4")
    ;
        UnOp = hash_string5,
        Cord = strcord("hash_string5")
    ;
        UnOp = hash_string6,
        Cord = strcord("hash_string6")
    ;
        UnOp = dword_float_get_word0,
        Cord = strcord("float_get_word0")
    ;
        UnOp = dword_float_get_word1,
        Cord = strcord("float_get_word1")
    ;
        UnOp = dword_int64_get_word0,
        Cord = strcord("int64_get_word0")
    ;
        UnOp = dword_int64_get_word1,
        Cord = strcord("int64_get_word1")
    ;
        UnOp = dword_uint64_get_word0,
        Cord = strcord("uint64_get_word0")
    ;
        UnOp = dword_uint64_get_word1,
        Cord = strcord("uint64_get_word1")
    ).

:- func binop_to_strcord(binary_op) = strcord.

binop_to_strcord(BinOp) = Cord :-
    (
        (
            BinOp = int_arith(IntType, ArithOp),
            OpStr = dump_arith_op(ArithOp)
        ;
            BinOp = int_cmp(IntType, CmpOp),
            OpStr = dump_cmp_op(CmpOp)
        ;
            BinOp = unchecked_left_shift(IntType, shift_by_int),
            OpStr = "raw_left_shift"
        ;
            BinOp = unchecked_left_shift(IntType, shift_by_uint),
            OpStr = "raw_left_ushift"
        ;
            BinOp = unchecked_right_shift(IntType, shift_by_int),
            OpStr = "raw_right_shift"
        ;
            BinOp = unchecked_right_shift(IntType, shift_by_uint),
            OpStr = "raw_right_ushift"
        ;
            BinOp = bitwise_and(IntType), OpStr = "bitwise_and"
        ;
            BinOp = bitwise_or(IntType),  OpStr = "bitwise_or"
        ;
            BinOp = bitwise_xor(IntType), OpStr = "bitwise_xor"
        ),
        Cord = strcord(OpStr) ++
            strcord("<") ++ int_type_to_strcord(IntType) ++ strcord(">")
    ;
        BinOp = int_as_uint_cmp(CmpOp),
        (
            CmpOp = lt,
            Cord = strcord("unsigned_lt")
        ;
            CmpOp = le,
            Cord = strcord("unsigned_le")
        )
    ;
        BinOp = logical_and,
        Cord = strcord("logical_and")
    ;
        BinOp = logical_or,
        Cord = strcord("logical_or")
    ;
        BinOp = body,
        Cord = strcord("body")
    ;
        BinOp = string_unsafe_index_code_unit,
        Cord = strcord("string_raw_index_cu")
    ;
        BinOp = array_index(_Type),
        Cord = strcord("array_index")
    ;
        BinOp = offset_str_eq(Offset, MaybeSize),
        (
            MaybeSize = no_size,
            Cord = strcord("offset_str_eq") ++
                strcord("<") ++ intcord(Offset) ++ strcord(">")
        ;
            MaybeSize = size(Size),
            Cord = strcord("offset_strn_eq") ++
                strcord("<") ++ intcord(Offset) ++ strcord(",") ++
                intcord(Size) ++ strcord(">")
        )
    ;
        BinOp = str_cmp(CmpOp),
        OpStr = dump_cmp_op(CmpOp),
        Cord = strcord("str_" ++ OpStr)
    ;
        BinOp = str_nzp,
        Cord = strcord("str_nzp")
    ;
        BinOp = float_arith(ArithOp),
        OpStr = dump_arith_op(coerce(ArithOp)),
        Cord = strcord("float_" ++ OpStr)
    ;
        BinOp = float_cmp(CmpOp),
        OpStr = dump_cmp_op(CmpOp),
        Cord = strcord("float_" ++ OpStr)
    ;
        BinOp = float_from_dword,
        Cord = strcord("float_from_dword")
    ;
        BinOp = int64_from_dword,
        Cord = strcord("int64_from_dword")
    ;
        BinOp = uint64_from_dword,
        Cord = strcord("uint64_from_dword")
    ;
        BinOp = pointer_equal_conservative,
        Cord = strcord("ptr_eq")
    ).

:- func int_type_to_strcord(int_type) = strcord.

int_type_to_strcord(IntType) = strcord(Str) :-
    ( IntType = int_type_int,    Str = "int"
    ; IntType = int_type_uint,   Str = "uint"
    ; IntType = int_type_int8,   Str = "int8"
    ; IntType = int_type_uint8,  Str = "uint8"
    ; IntType = int_type_int16,  Str = "int16"
    ; IntType = int_type_uint16, Str = "uint16"
    ; IntType = int_type_int32,  Str = "int32"
    ; IntType = int_type_uint32, Str = "uint32"
    ; IntType = int_type_int64,  Str = "int64"
    ; IntType = int_type_uint64, Str = "uint64"
    ).

%---------------------------------------------------------------------------%

:- func mlds_types_to_strcord(mlds_type, list(mlds_type)) = strcord.

mlds_types_to_strcord(HeadType, TailTypes) = Cord :-
    (
        TailTypes = [],
        Cord = mlds_type_to_strcord(HeadType)
    ;
        TailTypes = [HeadTailType | TailTailTypes],
        Cord = mlds_type_to_strcord(HeadType) ++ comma_cord ++
            mlds_types_to_strcord(HeadTailType, TailTailTypes)
    ).

:- func mercury_types_to_strcord(mer_type, list(mer_type)) = strcord.

mercury_types_to_strcord(HeadType, TailTypes) = Cord :-
    (
        TailTypes = [],
        Cord = mercury_type_to_strcord(HeadType)
    ;
        TailTypes = [HeadTailType | TailTailTypes],
        Cord = mercury_type_to_strcord(HeadType) ++ comma_cord ++
            mercury_types_to_strcord(HeadTailType, TailTailTypes)
    ).

%---------------------------------------------------------------------------%

:- func mlds_type_to_strcord(mlds_type) = strcord.

mlds_type_to_strcord(MLDS_Type) = Cord :-
    (
        MLDS_Type = mercury_nb_type(MerType, _CtorCat),
        Cord = mercury_type_to_strcord(MerType)
    ;
        MLDS_Type = mlds_mercury_array_type(MLDS_ElementType),
        Cord = strcord("mercury_array(") ++
            mlds_type_to_strcord(MLDS_ElementType) ++ strcord(")")
    ;
        MLDS_Type = mlds_array_type(MLDS_ElementType),
        Cord = strcord("array(") ++
            mlds_type_to_strcord(MLDS_ElementType) ++ strcord(")")
    ;
        MLDS_Type = mlds_mostly_generic_array_type(MLDS_ElementTypes),
        (
            MLDS_ElementTypes = [],
            Cord = strcord("mostly_generic_array()")
        ;
            MLDS_ElementTypes = [HeadType | TailTypes],
            Cord = strcord("mostly_generic_array(") ++
                mlds_types_to_strcord(HeadType, TailTypes) ++ strcord(")")
        )
    ;
        MLDS_Type = mlds_cont_type(MLDS_ReturnTypes),
        (
            MLDS_ReturnTypes = [],
            Cord = strcord("cont_type(return: <>)")
        ;
            MLDS_ReturnTypes = [HeadType | TailTypes],
            Cord = strcord("cont_type(return: <") ++
                mlds_types_to_strcord(HeadType, TailTypes) ++ strcord(">)")
        )
    ;
        MLDS_Type = mlds_commit_type,
        Cord = strcord("commit_type")
    ;
        MLDS_Type = mlds_native_bool_type,
        Cord = strcord("native bool")
    ;
        MLDS_Type = mlds_builtin_type_int(IntType),
        ( IntType = int_type_int,    Str = "int"
        ; IntType = int_type_int8,   Str = "int8"
        ; IntType = int_type_int16,  Str = "int16"
        ; IntType = int_type_int32,  Str = "int32"
        ; IntType = int_type_int64,  Str = "int64"
        ; IntType = int_type_uint,   Str = "uint"
        ; IntType = int_type_uint8,  Str = "uint8"
        ; IntType = int_type_uint16, Str = "uint16"
        ; IntType = int_type_uint32, Str = "uint32"
        ; IntType = int_type_uint64, Str = "uint64"
        ),
        Cord = strcord(Str)
    ;
        MLDS_Type = mlds_builtin_type_float,
        Cord = strcord("float")
    ;
        MLDS_Type = mlds_builtin_type_string,
        Cord = strcord("string")
    ;
        MLDS_Type = mlds_builtin_type_char,
        Cord = strcord("char")
    ;
        MLDS_Type = mlds_foreign_type(ForeignType),
        (
            ForeignType = c(c_type(TypeName)),
            Cord = strcord("c_type(") ++ strcord(TypeName) ++ strcord(")")
        ;
            ForeignType = java(java_type(TypeName)),
            Cord = strcord("java_type(") ++ strcord(TypeName) ++ strcord(")")
        ;
            ForeignType = csharp(csharp_type(TypeName)),
            Cord = strcord("csharp_type(") ++ strcord(TypeName) ++ strcord(")")
        )
    ;
        MLDS_Type = mlds_class_type(ClassId),
        ClassId = mlds_class_id(QualClassName, Arity),
        QualClassName = qual_class_name(_ModuleName, _QualKind, ClassName),
        Cord = strcord("class(") ++ strcord(ClassName) ++ strcord("/") ++
            intcord(Arity) ++ strcord(")")
    ;
        MLDS_Type = mlds_enum_class_type(EnumClassId),
        EnumClassId = mlds_enum_class_id(_ModuleName, EnumClassName, Arity),
        Cord = strcord("enum(") ++ strcord(EnumClassName) ++ strcord("/") ++
            intcord(Arity) ++ strcord(")")
    ;
        MLDS_Type = mlds_env_type(EnvId),
        EnvId = mlds_env_id(_ModuleName, EnvsName),
        Cord = strcord("env_struct(") ++ strcord(EnvsName) ++ strcord(")")
    ;
        MLDS_Type = mlds_struct_type(StructId),
        StructId = mlds_struct_id(_ModuleName, StructName),
        Cord = strcord("struct(") ++ strcord(StructName) ++ strcord(")")
    ;
        MLDS_Type = mlds_ptr_type(PointedToType),
        Cord = strcord("ptr_to(") ++ mlds_type_to_strcord(PointedToType) ++
            strcord(")")
    ;
        MLDS_Type = mlds_func_type(FuncParams),
        Cord = strcord("func_type(") ++
            mlds_func_params_to_strcord(FuncParams) ++ strcord(")")
    ;
        MLDS_Type = mlds_generic_type,
        Cord = strcord("generic")
    ;
        MLDS_Type = mlds_generic_env_ptr_type,
        Cord = strcord("generic_env_ptr")
    ;
        MLDS_Type = mlds_type_info_type,
        Cord = strcord("type_info")
    ;
        MLDS_Type = mlds_pseudo_type_info_type,
        Cord = strcord("pseudo_type_info")
    ;
        MLDS_Type = mlds_rtti_type(_),
        Cord = strcord("rtti_type")
    ;
        MLDS_Type = mlds_tabling_type(_),
        Cord = strcord("tabling_type")
    ;
        MLDS_Type = mlds_unknown_type,
        Cord = strcord("unknown_type")
    ).

:- func mlds_func_params_to_strcord(mlds_func_params) = strcord.

mlds_func_params_to_strcord(Params) = Cord :-
    Params = mlds_func_params(Args, ReturnTypes),
    (
        Args = [],
        ArgsCord = cord.init
    ;
        Args = [HeadArg | TailArgs],
        ArgsCord =
            strcord("(") ++
            mlds_arguments_to_strcord(HeadArg, TailArgs) ++
            strcord(")")
    ),
    (
        ReturnTypes = [],
        ReturnCord = cord.init
    ;
        ReturnTypes = [HeadReturnType | TailReturnTypes],
        ReturnCord =
            strcord("->(") ++
            mlds_types_to_strcord(HeadReturnType, TailReturnTypes) ++
            strcord(")")
    ),
    Cord = ArgsCord ++ ReturnCord.

:- func mercury_type_to_strcord(mer_type) = strcord.

mercury_type_to_strcord(MerType) = Cord :-
    (
        MerType = type_variable(TypeVar, _Kind),
        Cord = strcord("type_var_") ++ intcord(var_to_int(TypeVar))
    ;
        MerType = defined_type(TypeCtorSymName, ArgTypes, _Kind),
        TypeCtorName = unqualify_name(TypeCtorSymName),
        (
            ArgTypes = [],
            Cord = strcord(TypeCtorName)
        ;
            ArgTypes = [HeadArgType | TailArgTypes],
            Cord = strcord(TypeCtorName) ++ strcord("(") ++
                mercury_types_to_strcord(HeadArgType, TailArgTypes) ++
                strcord(")")
        )
    ;
        MerType = builtin_type(BuiltinType),
        (
            BuiltinType = builtin_type_int(IntType),
            Cord = int_type_to_strcord(IntType)
        ;
            BuiltinType = builtin_type_float,
            Cord = strcord("float")
        ;
            BuiltinType = builtin_type_string,
            Cord = strcord("string")
        ;
            BuiltinType = builtin_type_char,
            Cord = strcord("char")
        )
    ;
        MerType = tuple_type(ArgTypes, _Kind),
        (
            ArgTypes = [],
            Cord = strcord("{}")
        ;
            ArgTypes = [HeadArgType | TailArgTypes],
            Cord = strcord("{") ++
                mercury_types_to_strcord(HeadArgType, TailArgTypes) ++
                strcord("}")
        )
    ;
        MerType = higher_order_type(PorF, ArgTypes, _HoInstInfo, Purity),
        (
            Purity = purity_pure,
            PurityCord = cord.init
        ;
            Purity = purity_semipure,
            PurityCord = strcord("semipure_")
        ;
            Purity = purity_impure,
            PurityCord = strcord("impure_")
        ),
        (
            PorF = pf_function,
            PorFCord = strcord("func")
        ;
            PorF = pf_predicate,
            PorFCord = strcord("pred")
        ),
        (
            ArgTypes = [],
            ArgCord = cord.init
        ;
            ArgTypes = [HeadArgType | TailArgTypes],
            ArgCord = strcord("(") ++
                mercury_types_to_strcord(HeadArgType, TailArgTypes) ++
                strcord(")")
        ),
        Cord = PurityCord ++ PorFCord ++ ArgCord
    ;
        MerType = apply_n_type(TypeVar, ArgTypes, _Kind),
        (
            ArgTypes = [],
            Cord = strcord("apply_tvar_") ++ intcord(var_to_int(TypeVar))
        ;
            ArgTypes = [HeadArgType | TailArgTypes],
            Cord = strcord("apply_tvar_") ++ intcord(var_to_int(TypeVar)) ++
                strcord("(") ++
                mercury_types_to_strcord(HeadArgType, TailArgTypes) ++
                strcord(")")
        )
    ;
        MerType = kinded_type(SubType, _Kind),
        Cord = mercury_type_to_strcord(SubType)
    ).

%---------------------------------------------------------------------------%

:- func mlds_field_var_name_to_strcord(mlds_field_var_name) = strcord.

mlds_field_var_name_to_strcord(FieldVarName) = Cord :-
    (
        FieldVarName = fvn_global_data_field(TypeNum, FieldNum),
        Str = string.format("global data field <type %d, field %d>",
            [i(TypeNum), i(FieldNum)]),
        Cord = strcord(Str)
    ;
        FieldVarName = fvn_du_ctor_field_hld(FieldName),
        Cord = strcord("du ctor field hld ") ++ strcord(FieldName)
    ;
        FieldVarName = fvn_mr_value,
        Cord = strcord("mr_value")
    ;
        FieldVarName = fvn_data_tag,
        Cord = strcord("data_tag")
    ;
        FieldVarName = fvn_enum_const(ConstName),
        Cord = strcord("enum_const ") ++ strcord(ConstName)
    ;
        FieldVarName = fvn_ptr_num,
        Cord = strcord("ptr_num")
    ;
        FieldVarName = fvn_env_field_from_local_var(LocalVar),
        Cord = strcord("env field local var ") ++
            strcord(ml_local_var_name_to_string(LocalVar))
    ;
        FieldVarName = fvn_base_class(BaseNum),
        Cord = strcord("base class ") ++ intcord(BaseNum)
    ;
        FieldVarName = fvn_prev,
        Cord = strcord("prev")
    ;
        FieldVarName = fvn_trace,
        Cord = strcord("trace")
    ).

%---------------------------------------------------------------------------%

:- func mlds_local_var_defns_to_strcord(int, list(mlds_local_var_defn))
    = strcord.

mlds_local_var_defns_to_strcord(_Indent, []) = cord.init.
mlds_local_var_defns_to_strcord(Indent, [Defn | Defns]) =
    mlds_local_var_defn_to_strcord(Indent, Defn) ++
    mlds_local_var_defns_to_strcord(Indent, Defns).

:- func mlds_local_var_defn_to_strcord(int, mlds_local_var_defn) = strcord.

mlds_local_var_defn_to_strcord(Indent, LocalVarDefn) = Cord :-
    LocalVarDefn = mlds_local_var_defn(VarName, _Context, Type, Init, _Gc),
    (
        Init = no_initializer,
        InitCord = cord.init
    ;
        Init = init_obj(Rval),
        InitCord = strcord(" init_obj ") ++ mlds_rval_to_strcord(Rval)
    ;
        Init = init_struct(_Type, _Inits),
        InitCord = strcord(" init_struct(...)")
    ;
        Init = init_array(_Inits),
        InitCord = strcord(" init_array(...)")
    ),
    Cord = indent_strcord(Indent) ++ strcord("local ") ++
        strcord(ml_local_var_name_to_string(VarName)) ++ comma_cord ++
        mlds_type_to_strcord(Type) ++ InitCord ++ nl_strcord.

%---------------------------------------------------------------------------%

:- func mlds_function_defns_to_strcord(int, list(mlds_function_defn))
    = strcord.

mlds_function_defns_to_strcord(_Indent, []) = cord.init.
mlds_function_defns_to_strcord(Indent, [Defn | Defns]) =
    mlds_function_defn_to_strcord(Indent, Defn) ++
    mlds_function_defns_to_strcord(Indent, Defns).

:- func mlds_function_defn_to_strcord(int, mlds_function_defn) = strcord.

mlds_function_defn_to_strcord(Indent, FuncDefn) = Cord :-
    FuncDefn = mlds_function_defn(FuncName, _Context, _Flags, _OrigProc,
        Params, Body, _EnvVars, _TailRec),
    (
        FuncName = mlds_function_name(PlainFuncName),
        PlainFuncName = mlds_plain_func_name(FuncLabel, _PredId),
        FuncNameCord = mlds_func_label_to_strcord(FuncLabel)
    ;
        FuncName = mlds_function_export(FuncNameStr),
        FuncNameCord = strcord(FuncNameStr)
    ),
    (
        Body = body_external,
        BodyCord = indent_strcord(Indent + 1) ++ strcord("external")
    ;
        Body = body_defined_here(Stmt),
        BodyCord = mlds_stmt_to_strcord(Indent + 1, Stmt)
    ),
    Cord =
        indent_strcord(Indent) ++ strcord("func ") ++ FuncNameCord ++
            mlds_func_params_to_strcord(Params) ++ nl_strcord ++
        indent_strcord(Indent) ++ strcord("begin") ++ nl_strcord ++
        BodyCord ++
        indent_strcord(Indent) ++ strcord("end") ++ nl_strcord.

:- func mlds_arguments_to_strcord(mlds_argument, list(mlds_argument))
    = strcord.

mlds_arguments_to_strcord(HeadArg, TailArgs) = Cord :-
    (
        TailArgs = [],
        Cord = mlds_argument_to_strcord(HeadArg)
    ;
        TailArgs = [HeadTailArg | TailTailArgs],
        Cord = mlds_argument_to_strcord(HeadArg) ++ comma_cord ++
            mlds_arguments_to_strcord(HeadTailArg, TailTailArgs)
    ).

:- func mlds_argument_to_strcord(mlds_argument) = strcord.

mlds_argument_to_strcord(Arg) = Cord :-
    Arg = mlds_argument(LocalVarName, Type, _Gc),
    Cord = mlds_type_to_strcord(Type) ++ strcord(" ") ++
        strcord(ml_local_var_name_to_string(LocalVarName)).

:- func mlds_func_label_to_strcord(mlds_func_label) = strcord.

mlds_func_label_to_strcord(FuncLabel) = Cord :-
    FuncLabel = mlds_func_label(ProcLabel, MaybeAuxFuncId),
    ProcLabel = mlds_proc_label(PredLabel, ProcId),
    (
        PredLabel = mlds_user_pred_label(PorF, _MaybeModuleName,
            PredName, PredFormArity),
        PredFormArity = pred_form_arity(PredFormArityInt),
        (
            PorF = pf_function,
            PorFCord = strcord("func_")
        ;
            PorF = pf_predicate,
            PorFCord = strcord("pred_")
        ),
        PredCord = PorFCord ++ strcord(PredName) ++
            strcord("/") ++ intcord(PredFormArityInt)
    ;
        PredLabel = mlds_special_pred_label(PredName, _MaybeModuleName,
            TypeName, TypeArity),
        PredCord = strcord(PredName) ++ strcord("_for_") ++
            strcord(TypeName) ++ strcord("/") ++ intcord(TypeArity)
    ),
    ProcCord = strcord("-") ++ intcord(proc_id_to_int(ProcId)),
    (
        MaybeAuxFuncId = proc_func,
        AuxCord = cord.init
    ;
        MaybeAuxFuncId = proc_aux_func(SeqNum),
        AuxCord = strcord("$aux_") ++ intcord(SeqNum)
    ;
        MaybeAuxFuncId = gc_trace_for_proc_func,
        AuxCord = strcord("$gc")
    ;
        MaybeAuxFuncId = gc_trace_for_proc_aux_func(SeqNum),
        AuxCord = strcord("$gc_aux_") ++ intcord(SeqNum)
    ),
    Cord = PredCord ++ ProcCord ++ AuxCord.

%---------------------------------------------------------------------------%

:- func comma_cord = strcord.

comma_cord = strcord(", ").

:- func strcord(string) = strcord.

strcord(Str) = cord.singleton(Str).

:- func intcord(int) = strcord.

intcord(N) = cord.singleton(string.int_to_string(N)).

:- func indent_strcord(int) = strcord.

indent_strcord(Indent) = Cord :-
    ( if
        ( Indent = 0, CordPrime = cord.init
        ; Indent = 1, CordPrime = cord.singleton("  ")
        ; Indent = 2, CordPrime = cord.singleton("    ")
        ; Indent = 3, CordPrime = cord.singleton("      ")
        ; Indent = 4, CordPrime = cord.singleton("        ")
        ; Indent = 5, CordPrime = cord.singleton("          ")
        )
    then
        Cord = CordPrime
    else if
        Indent > 0
    then
        Half = Indent / 2,
        Cord = indent_strcord(Half) ++ indent_strcord(Indent - Half)
    else
        unexpected($pred, "negative Indent")
    ).

:- func nl_strcord = strcord.

nl_strcord = cord.singleton("\n").

%---------------------------------------------------------------------------%
:- end_module ml_backend.mlds_dump.
%---------------------------------------------------------------------------%
