[m-rev.] trivial diff: workaround source distribution build problem

[Julien Fischer]

On Mon, 26 Jan 2009, Julien Fischer wrote:

> I'll look into what the actual problem here is tomorrow.

The attached test case exhibits the bug, which is an abort
in the code generator with:

Uncaught Mercury exception:
Software Error: code_gen.m: Unexpected: nondet model in det/semidet
context

(I will add this to the bug database once it the current problems
with it have been repaired.)

Julien.
-------------- next part --------------
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% This test case is derived from r1.135 of compiler/compile_target_code.m.
%
%  Compiling with:
%  mmc -C -O0 --inline-compound-threshold=16 --local-constraint-propagation
%  results in:
%
%  Uncaught Mercury exception:
%  Software Error: code_gen.m: Unexpected: nondet model in det/semidet context
%
%-----------------------------------------------------------------------------%

:- module ctc_bad_detism.
:- interface.

:- import_module bool.
:- import_module io.

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


:- pred output_library_link_flags(io.output_stream::in, io::di, io::uo) is det.

:- pred shared_libraries_supported(bool::out, io::di, io::uo) is det.

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

:- implementation.

:- import_module list.
:- import_module maybe.
:- import_module string.

:- type option
    --->    linker_path_flag
    ;       linker_rpath_flag
    ;       linker_rpath_separator
    ;       shlib_linker_rpath_flag
    ;       shlib_linker_rpath_separator
    ;       shlib_linker_install_name_flag
    ;       shlib_linker_install_name_path.

:- type linked_target_type
    --->    executable
    ;       shared_library.

:- pred get_runtime_library_path_opts(linked_target_type::in,
    option::in(bound(shlib_linker_rpath_flag ; linker_rpath_flag)),
    option::in(bound(shlib_linker_rpath_separator ; linker_rpath_separator)),
    string::out, io::di, io::uo) is det.

get_runtime_library_path_opts(LinkTargetType, RpathFlagOpt, RpathSepOpt, RpathOpts, !IO) :-
    shared_libraries_supported(SharedLibsSupported, !IO),
    lookup_linkage(Linkage, !IO),
    (
        SharedLibsSupported = yes,
        ( Linkage = "shared"
        ; LinkTargetType = shared_library
        )
    ->
        lookup_rpath_dirs(RpathDirs, !IO),
        ( 
            RpathDirs = [],
            RpathOpts = ""
        ;
            RpathDirs = [_ | _],
            lookup_string_option(RpathSepOpt, RpathSep, !IO),
            lookup_string_option(RpathFlagOpt, RpathFlag, !IO),
            RpathOpts = RpathSep ++ RpathFlag
        )
    ;
        RpathOpts = ""
    ).

output_library_link_flags(Stream, !IO) :-
    LinkTargetType = executable,
    RpathFlagOpt = linker_rpath_flag,
    RpathSepOpt = linker_rpath_separator,
    get_runtime_library_path_opts(LinkTargetType, RpathFlagOpt, RpathSepOpt,
        RpathOpts, !IO), 
    string.append_list([RpathOpts], LinkFlags),
    io.write_string(Stream, LinkFlags, !IO).

shared_libraries_supported(Supported, !IO) :-
    lookup_lib_ext(LibExt, !IO),
    lookup_shlib_ext(SharedLibExt, !IO),
    Supported = (if LibExt \= SharedLibExt then yes else no).

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

:- pragma no_inline(lookup_linkage/3).
:- pred lookup_linkage(string::out, io::di, io::uo) is det.

lookup_linkage("", !IO).

:- pragma no_inline(lookup_rpath_dirs/3).
:- pred lookup_rpath_dirs(list(string)::out, io::di, io::uo) is det.

lookup_rpath_dirs([], !IO).

:- pragma no_inline(lookup_lib_ext/3).
:- pred lookup_lib_ext(string::out, io::di, io::uo) is det.

lookup_lib_ext("", !IO).

:- pragma no_inline(lookup_shlib_ext/3).
:- pred lookup_shlib_ext(string::out, io::di, io::uo) is det.

lookup_shlib_ext("", !IO).

:- pragma no_inline(lookup_string_option/4).
:- pred lookup_string_option(option::in, string::out, io::di, io::uo) is det.

lookup_string_option(_, "", !IO).

%-----------------------------------------------------------------------------%
:- end_module ctc_bad_detism.
%-----------------------------------------------------------------------------%