Files
mercury/tests/structure_reuse/interpret.m
Zoltan Somogyi fdd141bf77 Clean up the tests in the other test directories.
tests/invalid/*.{m,err_exp}:
tests/misc_tests/*.m:
tests/mmc_make/*.m:
tests/par_conj/*.m:
tests/purity/*.m:
tests/stm/*.m:
tests/string_format/*.m:
tests/structure_reuse/*.m:
tests/submodules/*.m:
tests/tabling/*.m:
tests/term/*.m:
tests/trailing/*.m:
tests/typeclasses/*.m:
tests/valid/*.m:
tests/warnings/*.{m,exp}:
    Make these tests use four-space indentation, and ensure that
    each module is imported on its own line. (I intend to use the latter
    to figure out which subdirectories' tests can be executed in parallel.)

    These changes usually move code to different lines. For the tests
    that check compiler error messages, expect the new line numbers.

browser/cterm.m:
browser/tree234_cc.m:
    Import only one module per line.

tests/hard_coded/boyer.m:
    Fix something I missed.
2015-02-16 12:32:18 +11:00

105 lines
2.8 KiB
Mathematica

%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
% A regression test.
% This tests a case where the compiler marked cells as being compile
% time garbage collectable, where references to that cell existed in
% other data structures.
%---------------------------------------------------------------------------%
:- module interpret.
:- interface.
:- import_module io.
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
:- import_module exception.
:- import_module list.
:- import_module map.
:- import_module float.
:- import_module int.
:- import_module require.
:- type element
---> float(float)
; int(int).
:- type operation
---> addf
; addi
; float(float)
; lookup
; pop.
:- type stack == list(element).
:- type env == map(int, element).
main -->
{ Env = map__set(map__init, 1, int(5)) },
{ Stack0 = [int(1)] },
{ Ops = [lookup, float(3.14)] },
{ interpret(Ops, Env, Stack0, Stack1) },
% This list must be of at least length two to as the
% first cell is correctly marked as not being cgc'able.
{ Stack1 = [float(_), int(X0)] ->
X = X0
;
error("incorrect stack")
},
% XXX If int(X0) is incorrectly being marked as cgc'able
% then P will reuse it's memory and hence the later
% map__lookup will return int(3) instead of int(5).
{ P = int(3) },
io__write(P),
io__nl,
{ map__lookup(Env, 1, Q) },
( { Q = int(X) } ->
io__write_string("Element of map hasn't changed.\n")
;
io__write_string("BEEP! BEEP! Map changed!!!.\n")
).
:- pred interpret(list(operation)::in, env::in, stack::in, stack::out) is det.
interpret([], _, Stack, Stack).
interpret([Op | Ops], Env, Stack0, Stack) :-
do_op(Op, Env, Stack0, Stack1),
interpret(Ops, Env, Stack1, Stack).
:- pred do_op(operation::in, env::in, stack::in, stack::out) is det.
do_op(float(F), _Env, Stack, [float(F) | Stack]).
do_op(addi, _Env, Stack0, Stack) :-
( Stack0 = [int(A), int(B) | Stack1] ->
Stack = [int(A+B) | Stack1]
;
throw(Stack0)
).
do_op(addf, _Env, Stack0, Stack) :-
( Stack0 = [float(A), float(B) | Stack1] ->
Stack = [float(A+B) | Stack1]
;
error("addi: wrong arguments")
).
do_op(lookup, Env, Stack0, Stack) :-
( Stack0 = [int(Loc) | Stack1] ->
% Here we create an alias between the Env
% variable and the elements in the stack.
map__lookup(Env, Loc, Element),
Stack = [Element | Stack1]
;
error("lookup: wrong arguments")
).
do_op(pop, _Env, Stack0, Stack) :-
( Stack0 = [_ | Stack1] ->
Stack = Stack1
;
error("pop: no arguments on the stack")
).