% Compile with:
%   mmc -s asm_fast.gc --optimise-constructor-last-call -C soupy

% Uncaught Mercury exception:
% Software Error: predicate `ll_backend.var_locn.actually_place_var'/6: Unexpected: placing nondummy var 6 which has no state
% Stack dump follows:
%    0       pred exception.throw/1-0 (erroneous) (exception.m:313)
%    1       pred require.error/1-0 (erroneous) (require.m:172)
%    2       pred require.unexpected/2-0 (erroneous) (require.m:203)
%    3       pred ll_backend.var_locn.actually_place_var/6-0 (det) (var_locn.m:1807)
%    4       pred ll_backend.var_locn.var_locn_place_var/5-0 (det) (var_locn.m:1706)
%    5       pred ll_backend.var_locn.actually_place_vars/4-0 (det) (var_locn.m:1730)
%    6       pred ll_backend.var_locn.var_locn_place_vars/4-0 (det) (var_locn.m:1722)
%    7       pred ll_backend.code_loc_dep.setup_call/7-0 (det) (code_loc_dep.m:3325)

:- module soupy.
:- interface.

:- import_module io.

:- pred main(io, io).
:- mode main(di, uo) is det.

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

:- implementation.

:- type expr
    --->    box
    ;       pair(expr, expr)
    ;       app(fun, expr).

:- type fun
    --->    destruct_list(expr, fun)
    ;       map_pair(fun, fun).

:- type expr_type
    --->    box_type
    ;       pair_type(expr_type, expr_type)
    ;       list_type(expr_type).

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

:- pred type_check(expr, expr_type).
:- mode type_check(in, out) is det.

type_check(E, T) :-
    (
        E = box,
        T = box_type
    ;
        E = pair(E1, _E2),
        type_check(E1, T1),
        % don't need this call to reproduce
        %type_check(E2, T2),
        T2 = box_type,
        T = pair_type(T1, T2)
    ;
        E = app(Fun, _E0),
        % don't need this call to reproduce
        %type_check(E0, T0),
        T0 = box_type,
        ( if fun_type(Fun, T0, T1) then
            T = T1
        else
            T = box_type
        )
    ).

:- pred fun_type(fun, expr_type, expr_type).
:- mode fun_type(in, in, out) is semidet.

fun_type(Fun, ArgT, T) :-
    (
        Fun = destruct_list(E, Fun0),
        ArgT = list_type(T0),
        type_check(E, T),
        fun_type(Fun0, pair_type(T0, list_type(T0)), T)
    ;
        Fun = map_pair(Fun1, Fun2),
        ArgT = pair_type(FirstT0, SecondT0),
        fun_type(Fun1, FirstT0, FirstT),
        fun_type(Fun2, SecondT0, SecondT),
        T = pair_type(FirstT, SecondT)
    ).

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

main(!IO) :-
    type_check(box, _T).

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

:- end_module soupy.