From 1254ce2c4f18dcfa713020194dc9aeac39b9a8bb Mon Sep 17 00:00:00 2001
From: ronny
Date: Tue, 5 Jun 2001 08:54:03 +0000
Subject: introduced  newFunctionWithType

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@466 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
---
 frontend/convertcases.icl | 20 ++++++++++++++------
 1 file changed, 14 insertions(+), 6 deletions(-)

(limited to 'frontend')

diff --git a/frontend/convertcases.icl b/frontend/convertcases.icl
index edfe56e..de79456 100644
--- a/frontend/convertcases.icl
+++ b/frontend/convertcases.icl
@@ -655,20 +655,28 @@ where
 
 newFunction :: !(Optional Ident) !FunctionBody ![FreeVar] ![AType] !AType !Int !(!Int, ![FunctionInfoPtr],!*FunctionHeap)
 	-> (! SymbIdent, !(!Int, ![FunctionInfoPtr],!*FunctionHeap))
-newFunction opt_id fun_bodies local_vars arg_types result_type group_index (cs_next_fun_nr, cs_new_functions, cs_fun_heap)
-	# (fun_def_ptr, cs_fun_heap) = newPtr FI_Empty cs_fun_heap
-	  fun_id = getIdent opt_id cs_next_fun_nr
-	  arity = length arg_types
+newFunction opt_id fun_bodies local_vars arg_types result_type group_index state
+	=	newFunctionWithType opt_id fun_bodies local_vars fun_type group_index state
+	where
 	  fun_type =
-	  	{	st_vars			= []
+		{	st_vars			= []
 		,	st_args			= arg_types
-		,	st_arity		= arity
+		,	st_arity		= length arg_types // -*-> ("newFunction", fun_id.id_name)
 		,	st_result		= result_type
 		,	st_context		= []
 		,	st_attr_vars	= []
 		,	st_attr_env		= []
 		}
 
+newFunctionWithType :: !(Optional Ident) !FunctionBody ![FreeVar] !SymbolType !Int !(!Int, ![FunctionInfoPtr],!*FunctionHeap)
+	-> (! SymbIdent, !(!Int, ![FunctionInfoPtr],!*FunctionHeap))
+newFunctionWithType opt_id fun_bodies local_vars fun_type group_index (cs_next_fun_nr, cs_new_functions, cs_fun_heap)
+	# (fun_def_ptr, cs_fun_heap) = newPtr FI_Empty cs_fun_heap
+	  fun_id = getIdent opt_id cs_next_fun_nr
+
+	  arity
+	  	=	fun_type.st_arity
+
 	  fun_def = 
 			{	fun_symb		= fun_id
 			,	fun_arity		= arity
-- 
cgit v1.2.3