Files
mercury/compiler/mercury_to_c.m
Zoltan Somogyi 9e31ef9baa Split llds into two parts. llds.m defines the data types, while llds_out.m
Estimated hours taken: 1.5

Split llds into two parts. llds.m defines the data types, while llds_out.m
has the predicates for printing the code.

Removed the call_closure instruction. Instead, we use calls to the
system-defined addresses do_call_{det,semidet,nondet}_closure. This is
how call_closure was implemented already. The advantage of the new
implementation is that it allows jump optimization of what used to be
call_closures, without new code in jumpopt.
1996-04-24 08:59:06 +00:00

1013 lines
31 KiB
Mathematica

%-----------------------------------------------------------------------------%
% Copyright (C) 1995 University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
% File: mercury_to_c.m
% Main author: fjh
% This module is an alternative to the original code generator.
% It generates much higher-level C than the original code generator.
% XXX This is still very incomplete!!!
% Done:
% - function prototypes
% - code generation for det & semidet predicates:
% - conjunctions
% - negation
% - if-then-else
% - predicate calls
% - unifications
% - assignment
% - simple test on integers
% TODO:
% Everything else, including
% - code generation for nondet predicates
% - disjunctions
% - switches
% - c_code pragmas
% - construct/deconstruct/complicated unifications
% - calls to builtin predicates
% - type declarations for user-defined types
%-----------------------------------------------------------------------------%
:- module mercury_to_c.
:- interface.
:- import_module hlds_module, llds.
:- import_module int, io.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% print out an entire hlds structure.
:- pred mercury_to_c__gen_hlds(int, module_info, io__state, io__state).
:- mode mercury_to_c__gen_hlds(in, in, di, uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module hlds_pred, hlds_goal, hlds_data, prog_data.
:- import_module llds_out, prog_out, prog_io, mercury_to_mercury.
:- import_module prog_util, mode_util, hlds_out, stack, quantification.
:- import_module globals, options.
:- import_module string, map, list, require, std_util, term, term_io, getopt.
:- import_module bool, set, varset.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- type c_gen_info
---> c_gen_info(
code_model,
module_info,
pred_id,
proc_id,
varset,
list(var), % output variables
% these must be prefixed with `*', since they
% are pointers
stack(c_failure_cont),
c_label, % label counter
c_label_func % label function counter
).
:- type c_failure_cont
---> semidet_fail % `return FALSE'
; nondet_fail % `return'
; goto(c_label) % `goto Label'
; call(c_label_func). % `LabelFunc()'
:- type c_label == int. % A number corresponding to a C label
:- type c_label_func == int. % A number corresponding to a GNU C
% nested function which serves as a label
:- type c_success_cont
---> semidet_succeed % `return TRUE'
; nondet_succeed % `cont()'
; goto(c_label). % `goto Label'
mercury_to_c__gen_hlds(Indent, Module) -->
c_gen_header(Indent, Module),
io__write_string("\n"),
{ module_info_types(Module, TypeTable) },
c_gen_types(Indent, TypeTable),
io__write_string("\n"),
{ module_info_preds(Module, PredTable) },
c_gen_preds(Indent, Module, PredTable),
io__write_string("\n"),
c_gen_footer(Indent, Module).
:- pred c_gen_header(int, module_info, io__state, io__state).
:- mode c_gen_header(in, in, di, uo) is det.
c_gen_header(Indent, Module) -->
{ module_info_name(Module, Name) },
c_gen_indent(Indent),
io__write_string("/* :- module "),
io__write_string(Name),
io__write_string(". */\n\n"),
c_gen_indent(Indent),
io__write_string("#include ""imp.h""\n\n").
:- pred c_gen_footer(int, module_info, io__state, io__state).
:- mode c_gen_footer(in, in, di, uo) is det.
c_gen_footer(Indent, Module) -->
{ module_info_name(Module, Name) },
c_gen_indent(Indent),
io__write_string("/* :- end_module "),
io__write_string(Name),
io__write_string(". */\n").
:- pred c_gen_preds(int, module_info, pred_table,
io__state, io__state).
:- mode c_gen_preds(in, in, in, di, uo) is det.
c_gen_preds(Indent, ModuleInfo, PredTable) -->
{ map__keys(PredTable, PredIds) },
c_gen_preds_2(Indent, ModuleInfo, PredIds, PredTable).
:- pred c_gen_preds_2(int, module_info, list(pred_id), pred_table,
io__state, io__state).
:- mode c_gen_preds_2(in, in, in, in, di, uo) is det.
c_gen_preds_2(Indent, ModuleInfo, PredIds0, PredTable) -->
(
{ PredIds0 = [PredId|PredIds] }
->
{ map__lookup(PredTable, PredId, PredInfo) },
( { pred_info_is_imported(PredInfo) } ->
[]
;
c_gen_pred(Indent, ModuleInfo, PredId,
PredInfo)
),
c_gen_preds_2(Indent, ModuleInfo, PredIds, PredTable)
;
[]
).
%-----------------------------------------------------------------------------%
:- pred c_gen_pred(int, module_info, pred_id, pred_info,
io__state, io__state).
:- mode c_gen_pred(in, in, in, in, di, uo) is det.
c_gen_pred(Indent, ModuleInfo, PredId, PredInfo) -->
{ pred_info_arg_types(PredInfo, TVarSet, ArgTypes) },
{ pred_info_context(PredInfo, Context) },
{ pred_info_name(PredInfo, PredName) },
{ pred_info_non_imported_procids(PredInfo, ProcIds) },
( { ProcIds = [] } ->
[]
;
c_gen_indent(Indent),
io__write_string("/****\n"),
mercury_output_pred_type(TVarSet, unqualified(PredName),
ArgTypes, no, Context),
{ pred_info_clauses_info(PredInfo, ClausesInfo) },
{ ClausesInfo = clauses_info(VarSet, _VarTypes, HeadVars,
Clauses) },
globals__io_lookup_bool_option(verbose_dump_hlds, Verbose),
globals__io_set_option(verbose_dump_hlds, bool(no)),
hlds_out__write_clauses(Indent, ModuleInfo, PredId, VarSet,
HeadVars, Clauses),
globals__io_set_option(verbose_dump_hlds, bool(Verbose)),
io__write_string("****/\n"),
c_gen_procs(Indent, ModuleInfo, PredId, PredInfo)
).
:- pred c_gen_type(type, io__state, io__state).
:- mode c_gen_type(in, di, uo) is det.
c_gen_type(Type) -->
( { Type = term__functor(term__atom("character"), [], _) } ->
io__write_string("char")
; { Type = term__functor(term__atom("int"), [], _) } ->
io__write_string("int")
; { Type = term__functor(term__atom("string"), [], _) } ->
io__write_string("String")
; { Type = term__functor(term__atom("float"), [], _) } ->
io__write_string("Float")
;
io__write_string("Word")
).
:- pred c_gen_procs(int, module_info, pred_id, pred_info,
io__state, io__state).
:- mode c_gen_procs(in, in, in, in, di, uo) is det.
c_gen_procs(Indent, ModuleInfo, PredId, PredInfo) -->
{ pred_info_non_imported_procids(PredInfo, ProcIds) },
c_gen_procs_2(ProcIds, ModuleInfo, Indent, PredId, PredInfo).
:- pred c_gen_procs_2(list(proc_id), module_info, int, pred_id,
pred_info, io__state, io__state).
:- mode c_gen_procs_2(in, in, in, in, in, di, uo) is det.
c_gen_procs_2([], _ModuleInfo, _Indent, _PredId, _PredInfo) -->
[].
c_gen_procs_2([ProcId | ProcIds], ModuleInfo, Indent, PredId, PredInfo) -->
{ pred_info_procedures(PredInfo, ProcTable) },
{ map__lookup(ProcTable, ProcId, ProcInfo) },
c_gen_proc(Indent, ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
c_gen_procs_2(ProcIds, ModuleInfo, Indent, PredId, PredInfo).
:- pred c_gen_proc(int, module_info, pred_id, proc_id, pred_info,
proc_info, io__state, io__state).
:- mode c_gen_proc(in, in, in, in, in, in, di, uo) is det.
c_gen_proc(Indent, ModuleInfo, PredId, ProcId, Pred, Proc) -->
{ proc_info_interface_determinism(Proc, InterfaceDeterminism) },
{ proc_info_variables(Proc, VarSet) },
{ proc_info_headvars(Proc, HeadVars) },
{ pred_info_name(Pred, PredName) },
{ proc_info_vartypes(Proc, VarTypes) },
{ proc_info_argmodes(Proc, HeadModes) },
{ proc_info_goal(Proc, Goal) },
{ proc_info_context(Proc, ModeContext) },
{ Indent1 is Indent + 1 },
c_gen_indent(Indent),
io__write_string("/*\n"),
c_gen_indent(Indent),
io__write_string("** "),
{ varset__init(ModeVarSet) },
mercury_output_pred_mode_decl(ModeVarSet, unqualified(PredName),
HeadModes, yes(InterfaceDeterminism), ModeContext),
c_gen_indent(Indent),
io__write_string("*/\n"),
c_gen_indent(Indent),
c_gen_prototype(ModuleInfo, PredId, ProcId),
io__write_string("\n"),
c_gen_indent(Indent),
io__write_string("{\n"),
c_gen_local_var_decls(Indent1, Goal, VarSet, VarTypes, HeadVars),
io__write_string("\n"),
{ determinism_to_code_model(InterfaceDeterminism, CodeModel) },
{ c_gen_select_output_vars(ModuleInfo, HeadVars, HeadModes,
OutputVars) },
{ c_gen_info_init(ModuleInfo, PredId, ProcId, VarSet, CodeModel,
OutputVars, CGenInfo0) },
( { CodeModel = model_non } ->
c_gen_predeclare_labels(Goal, CGenInfo0),
c_gen_indent(Indent1),
io__write_string("void MNL_0(void) {\n")
;
[]
),
c_gen_goal(Goal, Indent1, CGenInfo0, _CGenInfo),
( { CodeModel = model_non } ->
{ Indent2 is Indent1 + 1 },
c_gen_indent(Indent2),
io__write_string("cont();\n"),
c_gen_indent(Indent1),
io__write_string("}\n\n"),
c_gen_indent(Indent1),
io__write_string("MNL_0();\n")
; { CodeModel = model_semi } ->
c_gen_indent(Indent1),
io__write_string("return TRUE;\n")
;
[]
),
c_gen_indent(Indent),
io__write_string("}\n").
%-----------------------------------------------------------------------------%
:- pred c_gen_predeclare_labels(hlds__goal, c_gen_info, io__state, io__state).
:- mode c_gen_predeclare_labels(in, in, di, uo) is det.
% XXX this should traverse the goal and count how many function labels
% will be needed.
c_gen_predeclare_labels(_Goal, CGenInfo) -->
c_gen_predeclare_label(1, CGenInfo),
c_gen_predeclare_label(2, CGenInfo),
c_gen_predeclare_label(3, CGenInfo),
c_gen_predeclare_label(4, CGenInfo),
c_gen_predeclare_label(5, CGenInfo),
c_gen_predeclare_label(6, CGenInfo),
c_gen_predeclare_label(7, CGenInfo),
c_gen_predeclare_label(8, CGenInfo),
c_gen_predeclare_label(9, CGenInfo),
c_gen_predeclare_label(10, CGenInfo),
c_gen_predeclare_label(11, CGenInfo),
c_gen_predeclare_label(12, CGenInfo).
% XXX
:- pred c_gen_predeclare_label(int, c_gen_info, io__state, io__state).
:- mode c_gen_predeclare_label(in, in, di, uo) is det.
c_gen_predeclare_label(Label, CGenInfo) -->
io__write_string("\tauto void "),
c_gen_write_label_func(Label, CGenInfo),
io__write_string("(void);\n").
:- pred c_gen_write_label_func(int, c_gen_info, io__state, io__state).
:- mode c_gen_write_label_func(in, in, di, uo) is det.
c_gen_write_label_func(Label, _CGenInfo) -->
io__write_string("MNL_"),
io__write_int(Label).
:- pred c_gen_insert_label_func(c_label_func, int, c_gen_info,
io__state, io__state).
:- mode c_gen_insert_label_func(in, in, in, di, uo) is det.
c_gen_insert_label_func(Label, Indent, CGenInfo) -->
c_gen_indent(Indent),
io__write_string("}\n"),
c_gen_indent(Indent),
io__write_string("void "),
c_gen_write_label_func(Label, CGenInfo),
io__write_string("(void) {\n").
%
% generate the function prototype for a procedure
%
:- pred c_gen_prototype(module_info, pred_id, proc_id, io__state, io__state).
:- mode c_gen_prototype(in, in, in, di, uo) is det.
c_gen_prototype(ModuleInfo, PredId, ProcId) -->
{ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
PredInfo, ProcInfo) },
{ proc_info_interface_code_model(ProcInfo, CodeModel) },
{ proc_info_variables(ProcInfo, VarSet) },
{ proc_info_headvars(ProcInfo, HeadVars) },
{ pred_info_arg_types(PredInfo, _HeadTypeVarSet, HeadTypes) },
{ proc_info_argmodes(ProcInfo, HeadModes) },
( { CodeModel = model_semi } ->
io__write_string("bool")
;
io__write_string("void")
),
io__write_string(" "),
c_gen_proc_name(ModuleInfo, PredId, ProcId),
io__write_string("("),
( { HeadVars = [] } ->
( { CodeModel = model_non } ->
io__write_string("Cont cont")
;
io__write_string("void")
)
;
c_gen_arg_decls(ModuleInfo, HeadVars, HeadTypes, HeadModes,
VarSet),
( { CodeModel = model_non } ->
io__write_string(", Cont cont")
;
[]
)
),
io__write_string(")").
:- pred c_gen_proc_name(module_info, pred_id, proc_id, io__state, io__state).
:- mode c_gen_proc_name(in, in, in, di, uo) is det.
% XXX need to handle special_preds
% Also need to handle main/2 specially
c_gen_proc_name(ModuleInfo, PredId, ProcId) -->
{ predicate_module(ModuleInfo, PredId, ModuleName) },
{ predicate_name(ModuleInfo, PredId, PredName) },
{ predicate_arity(ModuleInfo, PredId, Arity) },
{ llds_out__name_mangle(PredName, MangledPredName) },
io__write_string("MP_"),
io__write_string("_"),
io__write_string(ModuleName),
io__write_string("__"),
io__write_string(MangledPredName),
io__write_string("_"),
io__write_int(Arity),
io__write_string("_"),
{ ModeNum is ProcId mod 10000 }, % strip off the priority
io__write_int(ModeNum).
:- pred c_gen_select_output_vars(module_info, list(var), list(mode), list(var)).
:- mode c_gen_select_output_vars(in, in, in, out) is det.
c_gen_select_output_vars(ModuleInfo, HeadVars, HeadModes, OutputVars) :-
(
HeadVars = [], HeadModes = []
->
OutputVars = []
;
HeadVars = [Var|Vars],
HeadModes = [Mode|Modes]
->
( mode_is_output(ModuleInfo, Mode) ->
OutputVars = [Var|OutputVars1],
c_gen_select_output_vars(ModuleInfo, Vars, Modes,
OutputVars1)
;
c_gen_select_output_vars(ModuleInfo, Vars, Modes,
OutputVars)
)
;
error("c_gen_select_output_vars: length mismatch")
).
:- pred c_gen_arg_decls(module_info, list(var), list(type), list(mode),
varset, io__state, io__state).
:- mode c_gen_arg_decls(in, in, in, in, in, di, uo) is det.
c_gen_arg_decls(ModuleInfo, HeadVars, HeadTypes, HeadModes, VarSet) -->
(
{ HeadVars = [], HeadTypes = [], HeadModes = [] }
->
[]
;
{ HeadVars = [Var|Vars] },
{ HeadTypes = [Type|Types] },
{ HeadModes = [Mode|Modes] }
->
c_gen_arg_decl(ModuleInfo, Var, Type, Mode, VarSet),
( { Vars \= [] } ->
io__write_string(", ")
;
[]
),
c_gen_arg_decls(ModuleInfo, Vars, Types, Modes, VarSet)
;
{ error("c_gen_arg_decls: length mismatch") }
).
:- pred c_gen_arg_decl(module_info, var, type, mode, varset,
io__state, io__state).
:- mode c_gen_arg_decl(in, in, in, in, in, di, uo) is det.
c_gen_arg_decl(ModuleInfo, Var, Type, Mode, VarSet) -->
c_gen_type(Type),
( { mode_is_output(ModuleInfo, Mode) } ->
io__write_string("* ")
;
io__write_string(" ")
),
mercury_output_var(Var, VarSet).
:- pred c_gen_local_var_decls(int, hlds__goal, varset, map(var, type),
list(var),
io__state, io__state).
:- mode c_gen_local_var_decls(in, in, in, in, in, di, uo) is det.
c_gen_local_var_decls(Indent, Goal, VarSet, VarTypes, HeadVars) -->
{ goal_vars(Goal, Vars0) },
{ set__to_sorted_list(Vars0, Vars) },
{ list__delete_elems(Vars, HeadVars, LocalVars) },
c_gen_local_var_decls_2(LocalVars, VarSet, VarTypes, Indent).
:- pred c_gen_local_var_decls_2(list(var), varset, map(var, type), int,
io__state, io__state).
:- mode c_gen_local_var_decls_2(in, in, in, in, di, uo) is det.
c_gen_local_var_decls_2([], _, _, _) --> [].
c_gen_local_var_decls_2([Var|Vars], VarSet, VarTypes, Indent) -->
c_gen_indent(Indent),
{ map__lookup(VarTypes, Var, Type) },
c_gen_type(Type),
io__write_string(" "),
mercury_output_var(Var, VarSet),
io__write_string(";\n"),
c_gen_local_var_decls_2(Vars, VarSet, VarTypes, Indent).
%-----------------------------------------------------------------------------%
:- pred c_gen_goal(hlds__goal, int, c_gen_info, c_gen_info,
io__state, io__state).
:- mode c_gen_goal(in, in, in, out, di, uo) is det.
c_gen_goal(Goal - GoalInfo, Indent, CGenInfo0, CGenInfo) -->
globals__io_lookup_bool_option(line_numbers, LineNumbers),
( { LineNumbers = yes } ->
{ goal_info_context(GoalInfo, Context) },
{ term__context_file(Context, FileName) },
{ term__context_line(Context, LineNumber) },
( { FileName \= "" } ->
io__write_string("#line "),
io__write_int(LineNumber),
io__write_string(" """),
io__write_string(FileName),
io__write_string("""\n")
;
[]
)
;
[]
),
c_gen_goal_2(Goal, Indent, CGenInfo0, CGenInfo).
:- pred c_gen_goal_2(hlds__goal_expr, int, c_gen_info, c_gen_info,
io__state, io__state).
:- mode c_gen_goal_2(in, in, in, out, di, uo) is det.
c_gen_goal_2(switch(Var, _CanFail, CasesList, _), Indent,
CGenInfo0, CGenInfo) -->
{ sorry(7) },
io__write_string("/* "),
% c_gen_can_fail(CanFail),
io__write_string(" switch on `"),
mercury_output_var(Var, _VarSet),
io__write_string("' */"),
{ Indent1 is Indent + 1 },
mercury_output_newline(Indent1),
( { CasesList = [Case | Cases] } ->
c_gen_case(Case, Var, Indent1, CGenInfo0, CGenInfo1),
c_gen_cases(Cases, Var, Indent, CGenInfo1, CGenInfo)
;
io__write_string("fail"),
{ CGenInfo0 = CGenInfo }
),
mercury_output_newline(Indent),
io__write_string(")").
c_gen_goal_2(some(Vars, Goal), Indent, CGenInfo0, CGenInfo) -->
{ sorry(8) },
io__write_string("some ["),
mercury_output_vars(Vars, _VarSet),
io__write_string("] ("),
{ Indent1 is Indent + 1 },
mercury_output_newline(Indent1),
c_gen_goal(Goal, Indent1, CGenInfo0, CGenInfo),
mercury_output_newline(Indent),
io__write_string(")").
c_gen_goal_2(if_then_else(_Vars, A, B, C, _), Indent, CGenInfo0, CGenInfo)
-->
% XXX need to handle nondet
{ c_gen_info_new_label(ElseLabel, CGenInfo0, CGenInfo1) },
{ c_gen_info_get_failconts(CGenInfo1, FailureConts0) },
{ stack__push(FailureConts0, goto(ElseLabel), FailureConts) },
{ c_gen_info_set_failconts(CGenInfo1, FailureConts, CGenInfo2) },
c_gen_indent(Indent),
io__write_string("/* if */\n"),
{ Indent1 is Indent + 1 },
c_gen_goal(A, Indent1, CGenInfo2, CGenInfo3),
{ c_gen_info_set_failconts(CGenInfo3, FailureConts0, CGenInfo4) },
c_gen_indent(Indent),
io__write_string("/* then */\n"),
c_gen_goal(B, Indent1, CGenInfo4, CGenInfo5),
c_gen_indent(Indent1),
{ c_gen_info_new_label(EndIfLabel, CGenInfo5, CGenInfo6) },
io__write_string("goto ML_"),
io__write_int(EndIfLabel),
io__write_string(";\n"),
c_gen_label(ElseLabel, Indent1),
c_gen_indent(Indent),
io__write_string("/* else */\n"),
(
{ C = if_then_else(_, _, _, _, _) - _ }
->
c_gen_goal(C, Indent, CGenInfo6, CGenInfo)
;
c_gen_goal(C, Indent1, CGenInfo6, CGenInfo)
),
c_gen_label(EndIfLabel, Indent1),
c_gen_indent(Indent),
io__write_string("/* end if */\n").
c_gen_goal_2(not(Goal), Indent, CGenInfo0, CGenInfo) -->
{ c_gen_info_new_label(SuccessLabel, CGenInfo0, CGenInfo1) },
{ c_gen_info_get_failconts(CGenInfo1, FailureConts0) },
{ stack__push(FailureConts0, goto(SuccessLabel), FailureConts) },
{ c_gen_info_set_failconts(CGenInfo1, FailureConts, CGenInfo2) },
c_gen_indent(Indent),
io__write_string("/* not */\n"),
{ Indent1 is Indent + 1 },
c_gen_goal(Goal, Indent1, CGenInfo2, CGenInfo3),
{ c_gen_info_set_failconts(CGenInfo3, FailureConts0, CGenInfo4) },
c_gen_failure(Indent1, CGenInfo4, CGenInfo),
c_gen_label(SuccessLabel, Indent1),
c_gen_indent(Indent),
io__write_string("/* end not */\n").
c_gen_goal_2(conj(Goals), Indent, CGenInfo0, CGenInfo) -->
c_gen_conj(Goals, Indent, CGenInfo0, CGenInfo).
c_gen_goal_2(disj(List, _), Indent, CGenInfo0, CGenInfo) -->
{ c_gen_info_get_code_model(CGenInfo0, CodeModel) },
( { CodeModel = model_non } ->
{ true }
;
{ sorry(5) }
),
( { List = [_Goal] } ->
{ sorry(12) }
; { List = [Goal | Goals] } ->
c_gen_indent(Indent),
io__write_string("/* disjunction */\n"),
% XXX need to fix failure conts
{ c_gen_info_new_label_func(Label, CGenInfo0, CGenInfo1) },
c_gen_disj([Goal | Goals], Label, Indent, CGenInfo1, CGenInfo),
c_gen_insert_label_func(Label, Indent, CGenInfo),
c_gen_indent(Indent),
io__write_string("/* end disjunction */\n")
;
c_gen_failure(Indent, CGenInfo0, CGenInfo)
).
c_gen_goal_2(call(PredId, ProcId, ArgVars, _, _, _PredName, _Follow),
Indent, CGenInfo0, CGenInfo) -->
{ c_gen_info_get_module_info(CGenInfo0, ModuleInfo) },
{ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
_PredInfo, ProcInfo) },
{ proc_info_interface_code_model(ProcInfo, CodeModel) },
{ proc_info_argmodes(ProcInfo, ArgModes) },
c_gen_indent(Indent),
( { CodeModel = model_non } ->
{ c_gen_info_new_label_func(Label, CGenInfo0, CGenInfo1) }
; { CodeModel = model_semi } ->
io__write_string("if (!"),
{ CGenInfo1 = CGenInfo0 },
{ Label = 0 }
;
{ CGenInfo1 = CGenInfo0 },
{ Label = 0 }
),
c_gen_proc_name(ModuleInfo, PredId, ProcId),
io__write_string("("),
c_gen_arg_list(ArgVars, ArgModes, CGenInfo1, CGenInfo2),
( { CodeModel = model_non } ->
( { ArgVars \= [] } ->
io__write_string(", ")
;
[]
),
c_gen_write_label_func(Label, CGenInfo2),
io__write_string(");\n"),
c_gen_failure(Indent, CGenInfo2, CGenInfo),
c_gen_insert_label_func(Label, Indent, CGenInfo)
; { CodeModel = model_semi } ->
io__write_string("))\n"),
{ Indent1 is Indent + 1 },
c_gen_failure(Indent1, CGenInfo2, CGenInfo)
;
{ CGenInfo = CGenInfo2 },
io__write_string(");\n")
).
c_gen_goal_2(unify(_A, _B, _, Unification, _), Indent, CGenInfo0, CGenInfo) -->
c_gen_unification(Unification, Indent, CGenInfo0, CGenInfo).
c_gen_goal_2(pragma_c_code(C_Code, _, _, _, ArgNameMap), _, _, _) -->
{ sorry(4) },
{ map__values(ArgNameMap, Names) },
io__write_string("$pragma(c_code, ["),
c_gen_string_list(Names),
io__write_string("], """),
io__write_string(C_Code),
io__write_string(""" )").
:- pred c_gen_string_list(list(string), io__state, io__state).
:- mode c_gen_string_list(in, di, uo) is det.
c_gen_string_list([]) --> [].
c_gen_string_list([Name]) -->
io__write_string(Name).
c_gen_string_list([Name1, Name2|Names]) -->
io__write_string(Name1),
io__write_string(", "),
c_gen_string_list([Name2|Names]).
:- pred c_gen_unification(unification, int, c_gen_info, c_gen_info,
io__state, io__state).
:- mode c_gen_unification(in, in, in, out, di, uo) is det.
c_gen_unification(assign(Var1, Var2), Indent, CGenInfo0, CGenInfo) -->
c_gen_indent(Indent),
c_gen_var(Var1, CGenInfo0, CGenInfo1),
io__write_string(" = "),
c_gen_var(Var2, CGenInfo1, CGenInfo),
io__write_string(";\n").
c_gen_unification(simple_test(Var1, Var2), Indent, CGenInfo0, CGenInfo) -->
c_gen_indent(Indent),
io__write_string("if ("),
c_gen_var(Var1, CGenInfo0, CGenInfo1),
io__write_string(" == "), % XXX string equality
c_gen_var(Var2, CGenInfo1, CGenInfo2),
io__write_string(")\n"),
{ Indent1 is Indent + 1 },
c_gen_failure(Indent1, CGenInfo2, CGenInfo).
c_gen_unification(construct(_, _, _, _), _Indent, CGenInfo, CGenInfo) -->
{ sorry(1) },
io__write_string(" :=: ").
c_gen_unification(deconstruct(_, _, _, _, _), _Indent, CGenInfo, CGenInfo) -->
{ sorry(2) },
io__write_string(" == ").
c_gen_unification(complicated_unify(_, _, _), _Indent, CGenInfo, CGenInfo) -->
{ sorry(3) },
io__write_string(" = ").
:- pred c_gen_arg_list(list(var), list(mode), c_gen_info, c_gen_info,
io__state, io__state).
:- mode c_gen_arg_list(in, in, in, out, di, uo) is det.
c_gen_arg_list(Vars, Modes, CGenInfo0, CGenInfo) -->
( { Vars = [], Modes = [] } ->
{ CGenInfo = CGenInfo0 }
; { Vars = [Var|Vars1], Modes = [Mode|Modes1] } ->
{ c_gen_info_get_module_info(CGenInfo0, ModuleInfo) },
{ c_gen_info_get_varset(CGenInfo0, VarSet) },
{ c_gen_info_get_output_vars(CGenInfo0, OutputVars) },
(
{ list__member(Var, OutputVars) },
{ \+ mode_is_output(ModuleInfo, Mode) }
->
io__write_char('*')
;
{ mode_is_output(ModuleInfo, Mode) },
{ \+ list__member(Var, OutputVars) }
->
io__write_char('&')
;
[]
),
mercury_output_var(Var, VarSet), % XXX name mangling
( { Vars1 = [] } ->
[]
;
io__write_string(", ")
),
c_gen_arg_list(Vars1, Modes1, CGenInfo0, CGenInfo)
;
{ error("c_gen_arg_list: length mismatch") }
).
:- pred c_gen_var(var, c_gen_info, c_gen_info, io__state, io__state).
:- mode c_gen_var(in, in, out, di, uo) is det.
c_gen_var(Var, CGenInfo, CGenInfo) -->
{ c_gen_info_get_varset(CGenInfo, VarSet) },
{ c_gen_info_get_output_vars(CGenInfo, OutputVars) },
( { list__member(Var, OutputVars) } ->
io__write_char('*')
;
[]
),
mercury_output_var(Var, VarSet). % XXX name mangling
:- pred sorry(int::in) is erroneous.
sorry(N) :-
string__format("Sorry, not implemented [%d]", [i(N)], ErrorMessage),
error(ErrorMessage).
:- pred c_gen_var_modes(list(var), list(mode), varset,
io__state, io__state).
:- mode c_gen_var_modes(in, in, in, di, uo) is det.
c_gen_var_modes([], [], _) --> [].
c_gen_var_modes([Var|Vars], [Mode|Modes], VarSet) -->
mercury_output_var(Var, VarSet),
io__write_string("::"),
mercury_output_mode(Mode, VarSet),
( { Vars \= [] } ->
io__write_string(", ")
;
[]
),
c_gen_var_modes(Vars, Modes, VarSet).
c_gen_var_modes([], [_|_], _) -->
{ error("c_gen_var_modes: length mis-match") }.
c_gen_var_modes([_|_], [], _) -->
{ error("c_gen_var_modes: length mis-match") }.
:- pred c_gen_conj(list(hlds__goal), int, c_gen_info, c_gen_info,
io__state, io__state).
:- mode c_gen_conj(in, in, in, out, di, uo) is det.
c_gen_conj([], _Indent, CGenInfo, CGenInfo) --> [].
c_gen_conj([Goal | Goals], Indent, CGenInfo0, CGenInfo) -->
c_gen_goal(Goal, Indent, CGenInfo0, CGenInfo1),
c_gen_conj(Goals, Indent, CGenInfo1, CGenInfo).
:- pred c_gen_disj(list(hlds__goal), c_label_func, int, c_gen_info, c_gen_info,
io__state, io__state).
:- mode c_gen_disj(in, in, in, in, out, di, uo) is det.
c_gen_disj([], _Label, _Indent, CGenInfo, CGenInfo) --> [].
c_gen_disj([Goal|Goals], Label, Indent, CGenInfo0, CGenInfo) -->
c_gen_goal(Goal, Indent, CGenInfo0, CGenInfo1),
io__write_string("MNL_"),
io__write_int(Label),
io__write_string("();\n"),
c_gen_disj(Goals, Label, Indent, CGenInfo1, CGenInfo).
:- pred c_gen_case(case, var, int, c_gen_info, c_gen_info,
io__state, io__state).
:- mode c_gen_case(in, in, in, in, out, di, uo) is erroneous.
c_gen_case(case(_ConsId, Goal), Var, Indent, CGenInfo0, CGenInfo) -->
{ sorry(10) },
mercury_output_var(Var, _VarSet),
io__write_string(" has functor "),
% c_gen_cons_id(ConsId),
io__write_string(","),
mercury_output_newline(Indent),
c_gen_goal(Goal, Indent, CGenInfo0, CGenInfo).
:- pred c_gen_cases(list(case), var, int, c_gen_info, c_gen_info,
io__state, io__state).
:- mode c_gen_cases(in, in, in, in, out, di, uo) is erroneous.
c_gen_cases(CasesList, Var, Indent, CGenInfo0, CGenInfo) -->
{ sorry(11) },
(
{ CasesList = [Case | Cases] }
->
mercury_output_newline(Indent),
io__write_string(";"),
{ Indent1 is Indent + 1 },
mercury_output_newline(Indent1),
c_gen_case(Case, Var, Indent1, CGenInfo0, CGenInfo1),
c_gen_cases(Cases, Var, Indent, CGenInfo1, CGenInfo)
;
[]
).
:- pred c_gen_var_types(int, varset, map(var, type), varset,
io__state, io__state).
:- mode c_gen_var_types(in, in, in, in, di, uo) is det.
c_gen_var_types(Indent, VarSet, VarTypes, TVarSet) -->
{ map__keys(VarTypes, Vars) },
c_gen_var_types_2(Vars, Indent, VarSet, VarTypes, TVarSet).
:- pred c_gen_var_types_2(list(var), int, varset, map(var, type),
varset, io__state, io__state).
:- mode c_gen_var_types_2(in, in, in, in, in, di, uo) is det.
c_gen_var_types_2([], _, _, _, _) --> [].
c_gen_var_types_2([Var | Vars], Indent, VarSet, VarTypes, TypeVarSet)
-->
{ map__lookup(VarTypes, Var, Type) },
c_gen_indent(Indent),
c_gen_type(Type),
io__write_string(" "),
mercury_output_var(Var, VarSet),
io__write_string(";\t/* "),
mercury_output_term(Type, TypeVarSet),
io__write_string(" */\n"),
c_gen_var_types_2(Vars, Indent, VarSet, VarTypes, TypeVarSet).
:- pred c_gen_types(int, type_table, io__state, io__state).
:- mode c_gen_types(in, in, di, uo) is det.
c_gen_types(_Indent, _X) -->
[].
% c_gen_indent(Indent),
% io__write_string("/* types */\n").
:- pred c_gen_indent(int, io__state, io__state).
:- mode c_gen_indent(in, di, uo) is det.
c_gen_indent(Indent) -->
(
{ Indent = 0 }
->
[]
;
io__write_char('\t'),
{ Indent1 is Indent - 1 },
c_gen_indent(Indent1)
).
%-----------------------------------------------------------------------------%
:- pred c_gen_label(c_label, int, io__state, io__state).
:- mode c_gen_label(in, in, di, uo) is det.
c_gen_label(Label, Indent) -->
{ UnIndent is Indent - 1 },
c_gen_indent(UnIndent),
io__write_string("ML_"),
io__write_int(Label),
io__write_string(":\n").
:- pred c_gen_failure(int, c_gen_info, c_gen_info, io__state, io__state).
:- mode c_gen_failure(in, in, out, di, uo) is det.
c_gen_failure(Indent, CGenInfo, CGenInfo) -->
{ c_gen_info_get_failconts(CGenInfo, FailContStack) },
( { stack__top(FailContStack, FailCont) } ->
c_gen_indent(Indent),
c_gen_failure_2(FailCont)
;
{ error("c_gen_failure: missing failure continuation") }
).
:- pred c_gen_failure_2(c_failure_cont, io__state, io__state).
:- mode c_gen_failure_2(in, di, uo) is det.
c_gen_failure_2(nondet_fail) -->
io__write_string("return;\n").
c_gen_failure_2(semidet_fail) -->
io__write_string("return FALSE;\n").
c_gen_failure_2(goto(Label)) -->
io__write_string("goto ML_"),
io__write_int(Label),
io__write_string(";\n").
c_gen_failure_2(call(Label)) -->
io__write_string("MNL_"),
io__write_int(Label),
io__write_string("();\n").
%-----------------------------------------------------------------------------%
:- pred c_gen_info_init(module_info, pred_id, proc_id, varset, code_model,
list(var), c_gen_info).
:- mode c_gen_info_init(in, in, in, in, in, in, out) is det.
c_gen_info_init(ModuleInfo, PredId, ProcId, VarSet, CodeModel, OutputVars,
CGenInfo) :-
stack__init(FailureContStack0),
( CodeModel = model_non ->
stack__push(FailureContStack0, nondet_fail, FailureContStack)
; CodeModel = model_semi ->
stack__push(FailureContStack0, semidet_fail, FailureContStack)
;
FailureContStack = FailureContStack0
),
LabelCounter = 0,
LabelFuncCounter = 0,
CGenInfo = c_gen_info(
CodeModel,
ModuleInfo,
PredId,
ProcId,
VarSet,
OutputVars,
FailureContStack,
LabelCounter,
LabelFuncCounter
).
:- pred c_gen_info_get_code_model(c_gen_info, code_model).
:- mode c_gen_info_get_code_model(in, out) is det.
c_gen_info_get_code_model(c_gen_info(CodeModel, _, _, _, _, _, _, _, _),
CodeModel).
:- pred c_gen_info_get_module_info(c_gen_info, module_info).
:- mode c_gen_info_get_module_info(in, out) is det.
c_gen_info_get_module_info(c_gen_info(_, ModuleInfo, _, _, _, _, _, _, _),
ModuleInfo).
:- pred c_gen_info_get_varset(c_gen_info, varset).
:- mode c_gen_info_get_varset(in, out) is det.
c_gen_info_get_varset(c_gen_info(_, _, _, _, VarSet, _, _, _, _), VarSet).
:- pred c_gen_info_get_output_vars(c_gen_info, list(var)).
:- mode c_gen_info_get_output_vars(in, out) is det.
c_gen_info_get_output_vars(c_gen_info(_, _, _, _, _, OutputVars, _, _, _),
OutputVars).
:- pred c_gen_info_get_failconts(c_gen_info, stack(c_failure_cont)).
:- mode c_gen_info_get_failconts(in, out) is det.
c_gen_info_get_failconts(c_gen_info(_, _, _, _, _, _, FailConts, _, _),
FailConts).
:- pred c_gen_info_set_failconts(c_gen_info, stack(c_failure_cont), c_gen_info).
:- mode c_gen_info_set_failconts(in, in, out) is det.
c_gen_info_set_failconts(c_gen_info(A, B, C, D, E, F, _, H, I), FailConts,
c_gen_info(A, B, C, D, E, F, FailConts, H, I)).
:- pred c_gen_info_new_label(c_label, c_gen_info, c_gen_info).
:- mode c_gen_info_new_label(out, in, out) is det.
c_gen_info_new_label(Label, c_gen_info(A, B, C, D, E, F, G, Label0, I),
c_gen_info(A, B, C, D, E, F, G, Label, I)) :-
Label is Label0 + 1.
:- pred c_gen_info_new_label_func(c_label_func, c_gen_info, c_gen_info).
:- mode c_gen_info_new_label_func(out, in, out) is det.
c_gen_info_new_label_func(Label, c_gen_info(A, B, C, D, E, F, G, H, Label0),
c_gen_info(A, B, C, D, E, F, G, H, Label)) :-
Label is Label0 + 1.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%