[m-rev.] for review: il as a foreign language

Tyson Dowd trd at cs.mu.OZ.AU
Fri Jul 13 00:37:05 AEST 2001


Apart from the documentation, I made the changes Fergus suggested.
The documentation is still being worked on.

===================================================================



Estimated hours taken: 40
Branches: main

Add support for foreign_proc("il", ....)

To use it, you need to give the options
	--use-foreign-language il
	--backend-foreign-language il

compiler/foreign.m:
compiler/globals.m:
	Handle the addition of il as a language option.


compiler/il_peephole.m:
compiler/ilasm.m:
	Handle the addition of il_asm_code as inlineable code.

compiler/ilds.m:
	Add a handwritten scope to the different scope types.

compiler/ml_code_gen.m:
	Handle the generation of code for IL foreign language interfacing.
	Put the max_stack_size attribute into IL foreign language code.

compiler/ml_elim_nested.m:
	Handle the new field in blocks indicating whether the block contains
	handwritten code.

compiler/mlds.m:
	Add lang_il as a possible target language.
	Add attributes to target code (max_stack_size is the only one so far).

compiler/mlds_to_c.m:
compiler/mlds_to_csharp.m:
compiler/mlds_to_java.m:
compiler/mlds_to_mcpp.m:
	Handle the addition of il as a language option.

compiler/mlds_to_il.m:
compiler/mlds_to_ilasm.m:
	Generate inline code for foreign_proc using IL.

compiler/prog_data.m:
	Add il as a language option.

	Add extra attributes to the pragma_foreign_proc_attributes.
	Currently there is just one extra attribute, max_stack_size.

compiler/prog_io_pragma.m:
	Parse max_stack_size as an attribute on foreign_proc.
	Improve error message output: previously we tried to parse the
	third term of a foreign_proc, and then tried to parse the second term
	(which we will accept for "c_code" but not foreign_proc).  
	But we should give the error message as if the "c_code" handling is
	not present, as this will eventually go away.
	Check for foreign_language attributes such as max_stack_size.



Here is the interdiff:


diff -b -u -r ws3/compiler/.#ml_code_gen.m.1.89 ws4/compiler/.#ml_code_gen.m.1.89
--- ws3/compiler/.#ml_code_gen.m.1.89	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/.#ml_code_gen.m.1.89	Thu Jul 12 16:24:23 2001
@@ -2403,7 +2403,7 @@
 	{ MLDS_Statements = [statement(block(VarLocals, [
 			ILCodeFragment | 
 			ByRefAssignStatements ++ CopiedOutputStatements
-		], yes), mlds__make_context(Context))] },
+		]), mlds__make_context(Context))] },
 	{ MLDS_Decls = [] }.
 
 
Only in ws3/compiler: .#ml_code_util.m.1.40
diff -b -u -r ws3/compiler/.#ml_elim_nested.m.1.31 ws4/compiler/.#ml_elim_nested.m.1.31
--- ws3/compiler/.#ml_elim_nested.m.1.31	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/.#ml_elim_nested.m.1.31	Thu Jul 12 16:24:24 2001
@@ -439,7 +439,7 @@
 					no, EnvTypeName, no, no, [], [])),
 				Context),
 		InitEnv = mlds__statement(block([], 
-			[NewObj, InitEnv0], no), Context),
+			[NewObj, InitEnv0]), Context),
 		EnvDecls = [EnvVarDecl, EnvPtrVarDecl]
 	;
 		EnvVarAddr = mem_addr(var(EnvVar, EnvTypeName)),
@@ -501,7 +501,7 @@
 		ml_init_env(TypeName, CastEnvPtrVal, Context, ModuleName,
 			Globals, EnvPtrDecl, InitEnvPtr),
 		FuncBody = mlds__statement(block([EnvPtrDecl],
-				[InitEnvPtr, FuncBody0], no), Context),
+				[InitEnvPtr, FuncBody0]), Context),
 		DefnBody = mlds__function(PredProcId, Params, yes(FuncBody)),
 		Defn = mlds__defn(Name, Context, Flags, DefnBody),
 		Init = yes
@@ -600,7 +600,7 @@
 	(if VarDecls = [], Statements = [SingleStatement] then
 		SingleStatement
 	else
-		mlds__statement(block(VarDecls, Statements, no), Context)
+		mlds__statement(block(VarDecls, Statements), Context)
 	).
 		
 %-----------------------------------------------------------------------------%
@@ -714,10 +714,10 @@
 
 flatten_stmt(Stmt0, Stmt) -->
 	(
-		{ Stmt0 = block(Defns0, Statements0, IsHandwritten) },
+		{ Stmt0 = block(Defns0, Statements0) },
 		flatten_nested_defns(Defns0, Statements0, Defns),
 		flatten_statements(Statements0, Statements),
-		{ Stmt = block(Defns, Statements, IsHandwritten) }
+		{ Stmt = block(Defns, Statements) }
 	;
 		{ Stmt0 = while(Rval0, Statement0, Once) },
 		fixup_rval(Rval0, Rval),
@@ -1254,7 +1254,7 @@
 
 stmt_contains_defn(Stmt, Defn) :-
 	(
-		Stmt = block(Defns, Statements, _IsHandwritten),
+		Stmt = block(Defns, Statements),
 		( defns_contains_defn(Defns, Defn)
 		; statements_contains_defn(Statements, Defn)
 		)
@@ -1384,7 +1384,7 @@
 
 stmt_contains_var(Stmt, Name) :-
 	(
-		Stmt = block(Defns, Statements, _IsHandwritten),
+		Stmt = block(Defns, Statements),
 		( defns_contains_var(Defns, Name)
 		; statements_contains_var(Statements, Name)
 		)
diff -b -u -r ws3/compiler/.#mlds.m.1.59 ws4/compiler/.#mlds.m.1.59
--- ws3/compiler/.#mlds.m.1.59	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/.#mlds.m.1.59	Thu Jul 12 16:24:24 2001
@@ -737,13 +737,7 @@
 	%
 	% sequence
 	%
-		block(mlds__defns, list(mlds__statement), bool)	
-			% the `bool' is yes iff the block contains
-			% handwritten foreign language code.  
-			% If so, this block can be considered a boundary for 
-			% optimization purposes -- the code within the block
-			% should not be optimized as the optimizer will not
-			% (in general) understand the foreign code.
+		block(mlds__defns, list(mlds__statement))	
 
 	%
 	% iteration
diff -b -u -r ws3/compiler/.#mlds_to_csharp.m.1.8 ws4/compiler/.#mlds_to_csharp.m.1.8
--- ws3/compiler/.#mlds_to_csharp.m.1.8	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/.#mlds_to_csharp.m.1.8	Thu Jul 12 16:24:24 2001
@@ -243,7 +243,7 @@
 		io__write_string(Code),
 		io__nl
 	;
-		{ Statement = block(Defns, Statements, _IsHandwritten) }
+		{ Statement = block(Defns, Statements) }
 	->
 		io__write_list(Defns, "", write_csharp_defn_decl),
 		io__write_string("{\n"),
diff -b -u -r ws3/compiler/.#mlds_to_il.m.1.41 ws4/compiler/.#mlds_to_il.m.1.41
--- ws3/compiler/.#mlds_to_il.m.1.41	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/.#mlds_to_il.m.1.41	Thu Jul 12 16:24:25 2001
@@ -278,9 +278,9 @@
 
 :- func rename_statement(mlds__statement) = mlds__statement.
 
-rename_statement(statement(block(Defns, Stmts, IsHandwritten), Context))
+rename_statement(statement(block(Defns, Stmts), Context))
 	= statement(block(list__map(rename_defn, Defns),
-			list__map(rename_statement, Stmts), IsHandwritten),
+			list__map(rename_statement, Stmts)),
 			Context).
 rename_statement(statement(while(Rval, Loop, IterateOnce), Context))
 	= statement(while(rename_rval(Rval),
@@ -1067,7 +1067,7 @@
 :- pred statement_to_il(mlds__statement, instr_tree, il_info, il_info).
 :- mode statement_to_il(in, out, in, out) is det.
 
-statement_to_il(statement(block(Defns, Statements, IsHandwritten), Context),
+statement_to_il(statement(block(Defns, Statements), Context),
 		Instrs) -->
 	il_info_get_module_name(ModuleName),
 	il_info_get_next_block_id(BlockId),
@@ -1079,13 +1079,7 @@
 	DataRep =^ il_data_rep,
 	{ list__map((pred((K - V)::in, (K - W)::out) is det :- 
 		W = mlds_type_to_ilds_type(DataRep, V)), Locals, ILLocals) },
-	{ 
-		IsHandwritten = yes
-	->
-		Scope = handwritten_scope(ILLocals)
-	;
-		Scope = scope(ILLocals)
-	},
+	{ Scope = scope(ILLocals) },
 	{ Instrs = tree__list([
 			context_node(Context),
 			instr_node(start_block(Scope, BlockId)),
@@ -1608,7 +1602,7 @@
 		T = target_code_output(_),
 		Instrs = empty
 	;
-		T = name(_ `with_type` mlds__qualified_entity_name),
+		T = name(_),
 		Instrs = empty
 	),
 	Rest = inline_code_to_il_asm(Ts).
diff -b -u -r ws3/compiler/.#mlds_to_mcpp.m.1.9 ws4/compiler/.#mlds_to_mcpp.m.1.9
--- ws3/compiler/.#mlds_to_mcpp.m.1.9	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/.#mlds_to_mcpp.m.1.9	Thu Jul 12 16:24:25 2001
@@ -280,8 +280,7 @@
 		io__write_list(CodeComponents, "\n", 
 			write_managed_cpp_code_component)
 	;
-		{ Statement = statement(block(Defns, Statements,
-			_IsHandwritten), _) }
+		{ Statement = statement(block(Defns, Statements), _) }
 	->
 		io__write_list(Defns, "", write_managed_cpp_defn_decl),
 		io__write_string("{\n"),
diff -b -u -r ws3/compiler/CVS/Entries ws4/compiler/CVS/Entries
--- ws3/compiler/il_peephole.m	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/il_peephole.m	Thu Jul 12 16:24:23 2001
@@ -233,13 +233,13 @@
 	Instrs = list__append(Replacement, Rest).
 
 	% Two patterns begin with start_scope.
-match(start_block(scope(Locals), Id), Instrs0, Instrs) :-
+match(start_block(scope(Locals), Id)) -->
 	( 
-		match2(start_block(scope(Locals), Id), Instrs0, Instrs1)
+		match_start_scope_1(start_block(scope(Locals), Id))
 	->
-		Instrs = Instrs1
+		[]
 	;	
-		match3(start_block(scope(Locals), Id), Instrs0, Instrs)
+		match_start_scope_2(start_block(scope(Locals), Id))
 	).
 
 	% If this is a scope with a local variable that is stored to but not
@@ -251,9 +251,9 @@
 	% stloc(X) patterns.
 	% This could be more efficient if it stopped looking outside the
 	% enclosing scope.
-:- pred match2(instr, instrs, instrs).
-:- mode match2(in, in, out) is semidet.
-match2(start_block(scope(Locals), Id), Instrs0, Instrs) :-
+:- pred match_start_scope_1(instr, instrs, instrs).
+:- mode match_start_scope_1(in, in, out) is semidet.
+match_start_scope_1(start_block(scope(Locals), Id), Instrs0, Instrs) :-
 
 		% Is this variable a local that is unused?
 	IsUnusedLocal = (pred(V::in) is semidet :-
@@ -267,6 +267,7 @@
 			X \= ldloc(V),
 			X \= ldloca(V)
 		), Instrs0, _, [])
+
 	),
 
 		% A producer, which finds "dup" and returns the rest of
@@ -304,6 +305,8 @@
 		R = V - Pre0 - Pre - Post
 	),
 
+	no_handwritten_code(Instrs0, Id),
+
 		% Keep looking for "dups" until it is followed by a
 		% suitable stloc.
 	keep_looking(FindDup, FindStloc, Instrs0, [] - [], Result, _Left),
@@ -325,9 +328,12 @@
 	% it.
 	% This could be more efficient if it stopped looking outside the
 	% enclosing scope.
-:- pred match3(instr, instrs, instrs).
-:- mode match3(in, in, out) is semidet.
-match3(start_block(scope(Locals), Id), Instrs0, Instrs) :-
+:- pred match_start_scope_2(instr, instrs, instrs).
+:- mode match_start_scope_2(in, in, out) is semidet.
+match_start_scope_2(start_block(scope(Locals), Id), Instrs0, Instrs) :-
+
+	no_handwritten_code(Instrs0, Id),
+
 		% The pattern
 	list__filter((pred(VarName - _Type::in) is semidet :-
 		Var = name(VarName),
@@ -342,6 +348,7 @@
 		Locals, UnusedLocals, UsedLocals),
 	UnusedLocals \= [],
 
+
 		% Comment and replacement
 	list__map((pred(VarName - _Type::in, Comment::out) is det :-
 		string__format(
@@ -370,6 +377,35 @@
 
 %-----------------------------------------------------------------------------%
 
+	% Succeeds if there is no handwritten code within the current block.
+:- pred no_handwritten_code(instrs::in, int::in) is semidet.
+
+no_handwritten_code([], _).
+no_handwritten_code([Instr | Instrs], Id) :-
+	( Instr = il_asm_code(_, _) ->
+		fail
+	; Instr = end_block(_, Id) ->
+		true
+	; Instr = start_block(_, SkipId) ->
+		InstrsAfterBlock = skip_over_block(Instrs, SkipId),
+		no_handwritten_code(InstrsAfterBlock, Id)
+	; 
+		no_handwritten_code(Instrs, Id)
+	).
+
+	% Skips over a block until the end of the block (with Id matching
+	% the given Id) is found.
+:- func skip_over_block(instrs, int) = instrs.
+skip_over_block([], _) = []. 
+skip_over_block([Instr | Instrs], Id) = 
+	( Instr = end_block(_, Id) ->
+		Instrs
+	;
+		skip_over_block(Instrs, Id)
+	).
+
+
+
 	% Skip over all the comments.
 :- pred skip_comments(instrs::in, instrs::out, instrs::out) is det.
 
@@ -522,8 +558,6 @@
 equivalent_to_nop(comment(_)) 				= yes.
 equivalent_to_nop(start_block(scope(_), _)) 		= yes.
 equivalent_to_nop(end_block(scope(_), _))	 	= yes.
-equivalent_to_nop(start_block(handwritten_scope(_), _))	= yes.
-equivalent_to_nop(end_block(handwritten_scope(_), _)) 	= yes.
 equivalent_to_nop(nop) 					= yes. 
 equivalent_to_nop(context(_, _)) 			= yes. 
 
diff -b -u -r ws3/compiler/ilasm.m ws4/compiler/ilasm.m
--- ws3/compiler/ilasm.m	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/ilasm.m	Thu Jul 12 16:24:23 2001
@@ -854,14 +854,6 @@
 	output_label(Label),
 	io__write_string(":").
 
-output_instr(start_block(handwritten_scope(Locals), Id), Info0, Info) -->
-	io__write_string("{"),
-	io__write_string("\t// (handwritten) #"),
-	io__write_int(Id),
-	io__write_string("\n\t.locals ("),
-	ilasm__write_list(Locals, ", ", output_local, Info0, Info),
-	io__write_string(")\n").
-
 output_instr(start_block(scope(Locals), Id), Info0, Info) -->
 	io__write_string("{"),
 	io__write_string("\t// #"),
@@ -883,11 +875,6 @@
 	io__write_int(Id).
 
 output_instr(end_block(scope(_), Id), I, I) -->
-	io__write_string("}"),
-	io__write_string("\t// #"),
-	io__write_int(Id).
-
-output_instr(end_block(handwritten_scope(_), Id), I, I) -->
 	io__write_string("}"),
 	io__write_string("\t// #"),
 	io__write_int(Id).
Only in ws3/compiler: ilasm.m.orig
diff -b -u -r ws3/compiler/ilds.m ws4/compiler/ilds.m
--- ws3/compiler/ilds.m	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/ilds.m	Thu Jul 12 16:24:23 2001
@@ -195,11 +195,6 @@
 
 		% scope just introduces a scope for local variables
 	--->	scope(locals)
-		% a handwritten_scope is just like scope, but the local
-		% variables should be assumed to be used in the handwritten
-		% code (and cannot, therefore, be eliminated if they appear
-		% to be unused elsewhere).
-	;	handwritten_scope(locals)
 	;	try
 	;	catch(class_name).
 
diff -b -u -r ws3/compiler/ml_code_gen.m ws4/compiler/ml_code_gen.m
--- ws3/compiler/ml_code_gen.m	Thu Jul 12 16:17:10 2001
+++ ws4/compiler/ml_code_gen.m	Thu Jul 12 16:28:36 2001
@@ -2436,7 +2436,7 @@
 	{ MLDS_Statements = [statement(block(VarLocals, [
 			ILCodeFragment | 
 			ByRefAssignStatements ++ CopiedOutputStatements
-		], yes), mlds__make_context(Context))] },
+		]), mlds__make_context(Context))] },
 	{ MLDS_Decls = [] }.
 
 
Only in ws4/compiler: ml_code_gen.m.orig
diff -b -u -r ws3/compiler/ml_code_util.m ws4/compiler/ml_code_util.m
--- ws3/compiler/ml_code_util.m	Thu Jul 12 16:17:12 2001
+++ ws4/compiler/ml_code_util.m	Thu Jul 12 16:28:36 2001
@@ -750,7 +750,7 @@
 	(if VarDecls = [], Statements = [SingleStatement] then
 		SingleStatement
 	else
-		mlds__statement(block(VarDecls, Statements, no),
+		mlds__statement(block(VarDecls, Statements),
 			mlds__make_context(Context))
 	).
 
@@ -1787,8 +1787,8 @@
 		MLDS_Stmt = call(ProxySignature, ProxyFuncRval, ObjectRval,
 			ProxyArgRvals, RetLvals, CallOrTailcall),
 		MLDS_Statement = mlds__statement(
-			block([Defn], [statement(MLDS_Stmt, MLDS_Context)],
-			no), MLDS_Context)
+			block([Defn], [statement(MLDS_Stmt, MLDS_Context)]), 
+			MLDS_Context)
 	;
 		error("success continuation generated was not a function")
 	}.
diff -b -u -r ws3/compiler/ml_elim_nested.m ws4/compiler/ml_elim_nested.m
--- ws3/compiler/ml_elim_nested.m	Thu Jul 12 16:17:12 2001
+++ ws4/compiler/ml_elim_nested.m	Thu Jul 12 16:28:40 2001
@@ -436,7 +436,7 @@
 					no, EnvTypeName, no, no, [], [])),
 				Context),
 		InitEnv = mlds__statement(block([], 
-			[NewObj, InitEnv0], no), Context),
+			[NewObj, InitEnv0]), Context),
 		EnvDecls = [EnvVarDecl, EnvPtrVarDecl]
 	;
 		EnvVarAddr = mem_addr(var(EnvVar, EnvTypeName)),
@@ -498,7 +498,7 @@
 		ml_init_env(TypeName, CastEnvPtrVal, Context, ModuleName,
 			Globals, EnvPtrDecl, InitEnvPtr),
 		FuncBody = mlds__statement(block([EnvPtrDecl],
-				[InitEnvPtr, FuncBody0], no), Context),
+				[InitEnvPtr, FuncBody0]), Context),
 		DefnBody = mlds__function(PredProcId, Params, yes(FuncBody)),
 		Defn = mlds__defn(Name, Context, Flags, DefnBody),
 		Init = yes
@@ -594,7 +594,7 @@
 	(if VarDecls = [], Statements = [SingleStatement] then
 		SingleStatement
 	else
-		mlds__statement(block(VarDecls, Statements, no), Context)
+		mlds__statement(block(VarDecls, Statements), Context)
 	).
 		
 %-----------------------------------------------------------------------------%
@@ -708,10 +708,10 @@
 
 flatten_stmt(Stmt0, Stmt) -->
 	(
-		{ Stmt0 = block(Defns0, Statements0, IsHandwritten) },
+		{ Stmt0 = block(Defns0, Statements0) },
 		flatten_nested_defns(Defns0, Statements0, Defns),
 		flatten_statements(Statements0, Statements),
-		{ Stmt = block(Defns, Statements, IsHandwritten) }
+		{ Stmt = block(Defns, Statements) }
 	;
 		{ Stmt0 = while(Rval0, Statement0, Once) },
 		fixup_rval(Rval0, Rval),
@@ -1248,7 +1248,7 @@
 
 stmt_contains_defn(Stmt, Defn) :-
 	(
-		Stmt = block(Defns, Statements, _IsHandwritten),
+		Stmt = block(Defns, Statements),
 		( defns_contains_defn(Defns, Defn)
 		; statements_contains_defn(Statements, Defn)
 		)
@@ -1378,7 +1378,7 @@
 
 stmt_contains_var(Stmt, Name) :-
 	(
-		Stmt = block(Defns, Statements, _IsHandwritten),
+		Stmt = block(Defns, Statements),
 		( defns_contains_var(Defns, Name)
 		; statements_contains_var(Statements, Name)
 		)
diff -b -u -r ws3/compiler/ml_optimize.m ws4/compiler/ml_optimize.m
--- ws3/compiler/ml_optimize.m	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/ml_optimize.m	Mon Jul  9 17:55:04 2001
@@ -126,14 +126,11 @@
 		Stmt0 = call(_, _, _, _, _, _),
 		Stmt = optimize_in_call_stmt(OptInfo, Stmt0)
 	;
-		Stmt0 = block(Defns0, Statements0, no),
+		Stmt0 = block(Defns0, Statements0),
 		convert_assignments_into_initializers(Defns0, Statements0,
 			OptInfo, Defns, Statements1),
 		Statements = optimize_in_statements(OptInfo, Statements1),
-		Stmt = block(Defns, Statements, no)
-	;
-		Stmt0 = block(_Defns0, _Statements0, yes),
-		Stmt = Stmt0
+		Stmt = block(Defns, Statements)
 	;
 		Stmt0 = while(Rval, Statement0, Once),
 		Stmt = while(Rval, optimize_in_statement(OptInfo, 
@@ -209,14 +206,14 @@
 		generate_assign_args(OptInfo, FuncArgs, CallArgs,
 			AssignStatements, AssignDefns),
 		AssignVarsStatement = statement(block(AssignDefns, 
-			AssignStatements, no), OptInfo ^ context),
+			AssignStatements), OptInfo ^ context),
 
 		CallReplaceStatements = [
 			CommentStatement,
 			AssignVarsStatement,
 			GotoStatement
 			],
-		Stmt = block([], CallReplaceStatements, no)
+		Stmt = block([], CallReplaceStatements)
 	;
 		Stmt = Stmt0
 	).
@@ -320,7 +317,7 @@
 		Label = label(tailcall_loop_label_name),
 		Stmt = block([], [statement(Comment, Context),
 			statement(Label, Context),
-			statement(Stmt0, Context)], no)
+			statement(Stmt0, Context)])
 	;
 		Stmt = Stmt0
 	).
diff -b -u -r ws3/compiler/ml_simplify_switch.m ws4/compiler/ml_simplify_switch.m
--- ws3/compiler/ml_simplify_switch.m	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/ml_simplify_switch.m	Sat Jan 20 16:42:47 2001
@@ -76,7 +76,7 @@
 			FirstVal, LastVal, NeedRangeCheck,
 			Type, Rval, MLDS_Context,
 			MLDS_Decls, MLDS_Statements),
-		{ Stmt = block(MLDS_Decls, MLDS_Statements, no) },
+		{ Stmt = block(MLDS_Decls, MLDS_Statements) },
 		{ Statement = mlds__statement(Stmt, MLDS_Context) }
 	;
 	%
@@ -269,10 +269,10 @@
 		{ InRange = binop(unsigned_le, Index,
 				const(int_const(Difference))) },
 		{ Else = yes(mlds__statement(
-			block([], DefaultStatements, no),
+			block([], DefaultStatements),
 			MLDS_Context)) },
 		{ SwitchBody = mlds__statement(
-			block([], [DoJump | CasesCode], no),
+			block([], [DoJump | CasesCode]),
 			MLDS_Context) },
 		{ DoSwitch = mlds__statement(
 			if_then_else(InRange, SwitchBody, Else),
@@ -420,12 +420,10 @@
 		MLDS_Statement :-
 	(
 		Default = default_do_nothing,
-		MLDS_Statement = mlds__statement(block([],[], no),
-			MLDS_Context)
+		MLDS_Statement = mlds__statement(block([],[]), MLDS_Context)
 	;
 		Default = default_is_unreachable,
-		MLDS_Statement = mlds__statement(block([],[], no),
-			MLDS_Context)
+		MLDS_Statement = mlds__statement(block([],[]), MLDS_Context)
 	;
 		Default = default_case(MLDS_Statement)
 	).
diff -b -u -r ws3/compiler/ml_string_switch.m ws4/compiler/ml_string_switch.m
--- ws3/compiler/ml_string_switch.m	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/ml_string_switch.m	Sun Jul  8 18:40:08 2001
@@ -156,7 +156,7 @@
 					MLDS_Context),
 				SwitchStatement,
 				GotoEndStatement
-			], no),
+			]),
 			MLDS_Context),
 		LoopBody = ml_gen_block([], [
 			mlds__statement(atomic(comment(
@@ -284,7 +284,7 @@
 			atomic(comment(CommentString)),
 			MLDS_Context) },
 		{ CaseStatement = mlds__statement(
-			block([], [Comment, GoalStatement], no),
+			block([], [Comment, GoalStatement]),
 			MLDS_Context) },
 		{ MLDS_Cases = [[match_value(const(int_const(Slot)))] -
 			CaseStatement] }
diff -b -u -r ws3/compiler/ml_tailcall.m ws4/compiler/ml_tailcall.m
--- ws3/compiler/ml_tailcall.m	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/ml_tailcall.m	Mon Jul  9 17:55:04 2001
@@ -204,12 +204,12 @@
 		% in that block.  The statement list will be in a
 		% tail position iff the block is in a tail position.
 		%
-		Stmt0 = block(Defns0, Statements0, IsHandwritten),
+		Stmt0 = block(Defns0, Statements0),
 		Defns = mark_tailcalls_in_defns(Defns0),
 		NewLocals = [defns(Defns) | Locals],
 		Statements = mark_tailcalls_in_statements(Statements0,
 				AtTail, NewLocals),
-		Stmt = block(Defns, Statements, IsHandwritten)
+		Stmt = block(Defns, Statements)
 	;
 		%
 		% The statement in the body of a while loop is never
diff -b -u -r ws3/compiler/ml_util.m ws4/compiler/ml_util.m
--- ws3/compiler/ml_util.m	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/ml_util.m	Fri Jun 22 11:14:34 2001
@@ -205,7 +205,7 @@
 
 stmt_contains_statement(Stmt, SubStatement) :-
 	(
-		Stmt = block(_Defns, Statements, _IsHandwritten),
+		Stmt = block(_Defns, Statements),
 		statements_contains_statement(Statements, SubStatement)
 	;
 		Stmt = while(_Rval, Statement, _Once),
diff -b -u -r ws3/compiler/mlds.m ws4/compiler/mlds.m
--- ws3/compiler/mlds.m	Thu Jul 12 16:17:14 2001
+++ ws4/compiler/mlds.m	Thu Jul 12 16:28:40 2001
@@ -764,13 +764,7 @@
 	%
 	% sequence
 	%
-		block(mlds__defns, list(mlds__statement), bool)	
-			% the `bool' is yes iff the block contains
-			% handwritten foreign language code.  
-			% If so, this block can be considered a boundary for 
-			% optimization purposes -- the code within the block
-			% should not be optimized as the optimizer will not
-			% (in general) understand the foreign code.
+		block(mlds__defns, list(mlds__statement))	
 
 	%
 	% iteration
diff -b -u -r ws3/compiler/mlds_to_c.m ws4/compiler/mlds_to_c.m
--- ws3/compiler/mlds_to_c.m	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/mlds_to_c.m	Thu Jul 12 16:24:24 2001
@@ -1871,7 +1871,7 @@
 	%
 	% sequence
 	%
-mlds_output_stmt(Indent, FuncInfo, block(Defns, Statements, _), Context) -->
+mlds_output_stmt(Indent, FuncInfo, block(Defns, Statements), Context) -->
 	mlds_indent(Indent),
 	io__write_string("{\n"),
 	( { Defns \= [] } ->
@@ -1931,7 +1931,7 @@
 		MaybeElse = yes(_),
 		Then0 = statement(if_then_else(_, _, no), ThenContext)
 	->
-		Then = statement(block([], [Then0], no), ThenContext)
+		Then = statement(block([], [Then0]), ThenContext)
 	;
 		%
 		% For examples of the form
@@ -1949,7 +1949,7 @@
 		MaybeElse = no,
 		Then0 = statement(if_then_else(_, _, yes(_)), ThenContext)
 	->
-		Then = statement(block([], [Then0], no), ThenContext)
+		Then = statement(block([], [Then0]), ThenContext)
 	;
 		Then = Then0
 	},
@@ -2187,7 +2187,7 @@
 		{
 			Stmt0 = statement(if_then_else(_, _, no), Context)
 		->
-			Stmt = statement(block([], [Stmt0], no), Context)
+			Stmt = statement(block([], [Stmt0]), Context)
 		;
 			Stmt = Stmt0
 		},
Only in ws3/compiler: mlds_to_c.m.orig
diff -b -u -r ws3/compiler/mlds_to_csharp.m ws4/compiler/mlds_to_csharp.m
--- ws3/compiler/mlds_to_csharp.m	Thu Jul 12 16:17:14 2001
+++ ws4/compiler/mlds_to_csharp.m	Thu Jul 12 16:28:40 2001
@@ -243,7 +243,7 @@
 		io__write_string(Code),
 		io__nl
 	;
-		{ Statement = block(Defns, Statements, _IsHandwritten) }
+		{ Statement = block(Defns, Statements) }
 	->
 		io__write_list(Defns, "", write_csharp_defn_decl),
 		io__write_string("{\n"),
diff -b -u -r ws3/compiler/mlds_to_gcc.m ws4/compiler/mlds_to_gcc.m
--- ws3/compiler/mlds_to_gcc.m	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/mlds_to_gcc.m	Thu Jul 12 16:24:25 2001
@@ -364,7 +364,7 @@
 		qual(MLDS_ModuleName, Name),
 		SymbolTable, LabelTable) },
 	{ term__context_init(Context) },
-	{ FuncBody = mlds__statement(block([], [], no),
+	{ FuncBody = mlds__statement(block([], []),
 		mlds__make_context(Context)) },
 	gcc__start_function(GCC_FuncDecl),
 	gen_statement(DefnInfo, FuncBody),
@@ -2349,7 +2349,7 @@
 	%
 	% sequence
 	%
-gen_stmt(DefnInfo0, block(Defns, Statements, _IsHandwritten), _Context) -->
+gen_stmt(DefnInfo0, block(Defns, Statements), _Context) -->
 	gcc__start_block,
 	{ FuncName = DefnInfo0 ^ func_name },
 	{ FuncName = qual(ModuleName, _) },
diff -b -u -r ws3/compiler/mlds_to_il.m ws4/compiler/mlds_to_il.m
--- ws3/compiler/mlds_to_il.m	Thu Jul 12 16:17:45 2001
+++ ws4/compiler/mlds_to_il.m	Thu Jul 12 16:28:42 2001
@@ -278,9 +278,9 @@
 
 :- func rename_statement(mlds__statement) = mlds__statement.
 
-rename_statement(statement(block(Defns, Stmts, IsHandwritten), Context))
+rename_statement(statement(block(Defns, Stmts), Context))
 	= statement(block(list__map(rename_defn, Defns),
-			list__map(rename_statement, Stmts), IsHandwritten),
+			list__map(rename_statement, Stmts)),
 			Context).
 rename_statement(statement(while(Rval, Loop, IterateOnce), Context))
 	= statement(while(rename_rval(Rval),
@@ -1070,7 +1070,7 @@
 :- pred statement_to_il(mlds__statement, instr_tree, il_info, il_info).
 :- mode statement_to_il(in, out, in, out) is det.
 
-statement_to_il(statement(block(Defns, Statements, IsHandwritten), Context),
+statement_to_il(statement(block(Defns, Statements), Context),
 		Instrs) -->
 	il_info_get_module_name(ModuleName),
 	il_info_get_next_block_id(BlockId),
@@ -1082,13 +1082,7 @@
 	DataRep =^ il_data_rep,
 	{ list__map((pred((K - V)::in, (K - W)::out) is det :- 
 		W = mlds_type_to_ilds_type(DataRep, V)), Locals, ILLocals) },
-	{ 
-		IsHandwritten = yes
-	->
-		Scope = handwritten_scope(ILLocals)
-	;
-		Scope = scope(ILLocals)
-	},
+	{ Scope = scope(ILLocals) },
 	{ Instrs = tree__list([
 			context_node(Context),
 			instr_node(start_block(Scope, BlockId)),
@@ -1611,7 +1605,7 @@
 		T = target_code_output(_),
 		Instrs = empty
 	;
-		T = name(_ `with_type` mlds__qualified_entity_name),
+		T = name(_),
 		Instrs = empty
 	),
 	Rest = inline_code_to_il_asm(Ts).
diff -b -u -r ws3/compiler/mlds_to_java.m ws4/compiler/mlds_to_java.m
--- ws3/compiler/mlds_to_java.m	Thu Jul 12 16:16:12 2001
+++ ws4/compiler/mlds_to_java.m	Mon Jul  9 17:55:07 2001
@@ -425,7 +425,7 @@
 			MaybeStatements0),
 		MaybeStatements0 = yes(Statements0),
 		Statements0 = mlds__statement(
-			block(BlockDefns0, _BlockList0, IsHandwritten), _) 
+			block(BlockDefns0, _BlockList0), _) 
 	->
 		%
 		% Create new method name
@@ -453,7 +453,7 @@
 		% to the original predicate and then return 
 		% what it returns
 		%
-		Block = block(BlockDefns, [], IsHandwritten),
+		Block = block(BlockDefns, []),
 		Statements = mlds__statement(Block, Context), 
 		%
 		% Put it all together.
@@ -1406,8 +1406,7 @@
 	%
 	% sequence
 	%
-output_stmt(Indent, FuncInfo, block(Defns, Statements, _IsHandwritten),
-		Context) -->
+output_stmt(Indent, FuncInfo, block(Defns, Statements), Context) -->
 	indent_line(Indent),
 	io__write_string("{\n"),
 	( { Defns \= [] } ->
@@ -1466,7 +1465,7 @@
 		MaybeElse = yes(_),
 		Then0 = statement(if_then_else(_, _, no), ThenContext)
 	->
-		Then = statement(block([], [Then0], no), ThenContext)
+		Then = statement(block([], [Then0]), ThenContext)
 	;
 		Then = Then0
 	},
diff -b -u -r ws3/compiler/mlds_to_mcpp.m ws4/compiler/mlds_to_mcpp.m
--- ws3/compiler/mlds_to_mcpp.m	Thu Jul 12 16:17:45 2001
+++ ws4/compiler/mlds_to_mcpp.m	Thu Jul 12 16:28:42 2001
@@ -280,8 +280,7 @@
 		io__write_list(CodeComponents, "\n", 
 			write_managed_cpp_code_component)
 	;
-		{ Statement = statement(block(Defns, Statements,
-			_IsHandwritten), _) }
+		{ Statement = statement(block(Defns, Statements), _) }
 	->
 		io__write_list(Defns, "", write_managed_cpp_defn_decl),
 		io__write_string("{\n"),

-- 
       Tyson Dowd           # 
                            #  Surreal humour isn't everyone's cup of fur.
     trd at cs.mu.oz.au        # 
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list