[m-rev.] diff: add test cases for mode inference & reordering

[Fergus Henderson]

Estimated hours taken: 0.25
Branches: main

tests/general/Mmakefile:
tests/general/mode_inference_reorder.m:
tests/general/mode_inference_reorder.exp:
tests/general/mode_inference_reorder.inp:
	Add a test case to test that mode inference supports mode reordering.
	(The test case in question is based on samples/calculator.m,
	with the type and mode declarations commented out, and with
	one of the clauses near the top rewritten so that the compiler
	has to reorder it to get the modes right.)

Workspace: /home/hg/fjh/ws-hg3/mercury
Index: tests/general/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/general/Mmakefile,v
retrieving revision 1.32
diff -u -d -r1.32 Mmakefile
--- tests/general/Mmakefile	2000/10/23 13:56:09	1.32
+++ tests/general/Mmakefile	2001/04/10 01:10:54
@@ -42,6 +42,7 @@
 		liveness2 \
 		mode_inf \
 		mode_inf_bug \
+		mode_inference_reorder \
 		mu \
 		nasty_nondet \
 		nondet_disj \
@@ -76,9 +77,11 @@
 # Some test cases need special handling.
 #
 
-# mode_inf and mode_inf_bug need to be compiled with `--infer-all'.
+# mode_inf, mode_inf_bug and mode_inference_reorder need to be compiled
+# with `--infer-all'.
 MCFLAGS-mode_inf = --infer-all
 MCFLAGS-mode_inf_bug = --infer-all
+MCFLAGS-mode_inference_reorder = --infer-all
 MCFLAGS-intermod_type = --intermodule-optimization
 MCFLAGS-intermod_type2 = --intermodule-optimization
 
Index: tests/general/mode_inference_reorder.exp
===================================================================
RCS file: mode_inference_reorder.exp
diff -N mode_inference_reorder.exp
--- /dev/null	Thu Mar 30 14:06:13 2000
+++ mode_inference_reorder.exp	Tue Apr 10 11:08:59 2001
@@ -0,0 +1,3 @@
+calculator> 601
+calculator> 43
+calculator> EOF
Index: tests/general/mode_inference_reorder.inp
===================================================================
RCS file: mode_inference_reorder.inp
diff -N mode_inference_reorder.inp
--- /dev/null	Thu Mar 30 14:06:13 2000
+++ mode_inference_reorder.inp	Tue Apr 10 11:08:43 2001
@@ -0,0 +1,2 @@
+1 + 200 * 3
+88 / 2 - 1
Index: tests/general/mode_inference_reorder.m
===================================================================
RCS file: mode_inference_reorder.m
diff -N mode_inference_reorder.m
--- /dev/null	Thu Mar 30 14:06:13 2000
+++ mode_inference_reorder.m	Tue Apr 10 11:06:07 2001
@@ -0,0 +1,105 @@
+
+:- module mode_inference_reorder.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+:- import_module list, char, int, string.
+
+:- type expr
+	--->	expr_number(int)
+	;	expr_plus(expr, expr)
+	;       expr_minus(expr, expr)
+	;       expr_times(expr, expr)
+	;       expr_div(expr, expr).
+
+main -->  main2.
+main2 -->
+	io__write_string("calculator> "),
+	io__flush_output,
+	io__read_line(Res),
+	( { Res = error(_) },
+		io__write_string("Error reading from stdin\n")
+	; { Res = eof },
+		io__write_string("EOF\n")
+	; { Res = ok(Line0) },
+		{ list__delete_all(Line0, ' ', Line) },
+		( { fullexpr(X,Line,[]) } ->
+			{ Num = evalexpr(X) },
+			io__write_int(Num),
+			io__write_string("\n")
+		;
+			io__write_string("Syntax error\n")
+		),
+		main	% recursively call ourself for the next line(s)
+	).
+
+:- func evalexpr(expr) = int.
+evalexpr(expr_number(Num)) = Num.
+evalexpr(expr_plus(X,Y)) = evalexpr(X) + evalexpr(Y).
+evalexpr(expr_minus(X,Y)) = evalexpr(X) - evalexpr(Y).
+evalexpr(expr_times(X,Y)) = evalexpr(X) * evalexpr(Y).
+evalexpr(expr_div(X,Y)) = evalexpr(X) // evalexpr(Y).
+
+% Simple recursive-descent parser.
+
+% :- pred fullexpr(expr::out, list(char)::in, list(char)::out) is semidet.
+fullexpr(X) -->
+	ord_expr(X),
+	['\n'].
+
+% :- pred expr(expr::out, list(char)::in, list(char)::out) is semidet.
+ord_expr(Expr, DCG0, DCG) :-
+	expr2(Factor, Expr, DCG1, DCG),
+	factor(Factor, DCG0, DCG1),
+	true.
+
+% :- pred expr2(expr::in, expr::out, list(char)::in, list(char)::out) is semidet.
+% :- pred expr2(expr::out(free), expr::out(free), list(char)::out(free),
+% 	list(char)::out(free)) is semidet.
+expr2(Factor, Expr) -->
+	( [('+') `with_type` char] -> factor(Factor2), expr2(expr_plus( Factor, Factor2), Expr)
+	; [('-') `with_type` char] -> factor(Factor2), expr2(expr_minus(Factor, Factor2), Expr)
+	; { Expr = Factor }
+	).
+
+% :- pred factor(expr::out, list(char)::in, list(char)::out) is semidet.
+factor(Factor) -->
+	term(Term),
+	factor2(Term, Factor).
+
+% :- pred factor2(expr::in, expr::out, list(char)::in, list(char)::out)
+% 	is semidet.
+factor2(Term, Factor) -->
+	( [('*') `with_type` char] -> term(Term2), factor2(expr_times(Term,Term2), Factor)
+	; [('/') `with_type` char] -> term(Term2), factor2(expr_div(  Term,Term2), Factor)
+	; { Factor = Term }
+	).
+
+% :- pred term(expr::out, list(char)::in, list(char)::out) is semidet.
+term(Term)	-->
+	( const(Const) ->
+		{ string__from_char_list(Const, ConstString) },
+		{ string__to_int(ConstString, Num) },
+		{ Term = expr_number(Num) }
+	;
+		['('], ord_expr(Term), [')']
+	).
+
+% :- pred const(list(char)::out, list(char)::in, list(char)::out) is semidet.
+const([Digit|Rest]) -->
+	digit(Digit),
+	( const(Const) ->
+		{ Rest = Const }
+	;
+		{ Rest = [] }
+	).
+
+% :- pred digit(char::out, list(char)::in, list(char)::out) is semidet.
+digit(Char) -->
+	[Char],
+	{ char__is_digit(Char) }.
+
+

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
                                    |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------