From 6b9c7b960e134377f50d4558fca56293d1375008 Mon Sep 17 00:00:00 2001
From: johnvg
Date: Wed, 5 Sep 2007 15:06:10 +0000
Subject: use an integer instead of a string in GenTypeVar

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@1685 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
---
 frontend/generics1.icl | 37 +++++++++++++++++++++++--------------
 frontend/syntax.dcl    |  5 ++---
 2 files changed, 25 insertions(+), 17 deletions(-)

(limited to 'frontend')

diff --git a/frontend/generics1.icl b/frontend/generics1.icl
index 59874ff..50748b0 100644
--- a/frontend/generics1.icl
+++ b/frontend/generics1.icl
@@ -721,10 +721,15 @@ where
 			# prio_expr = makeIntExpr prio		
 			= buildPredefConsApp PD_CGenConsPrio [assoc_expr, prio_expr] predefs heaps 
 
-		make_type_expr {st_args, st_result} heaps		
-			# (arg_exprs, heaps) = mapSt make_expr1 st_args heaps		
+		make_type_expr {st_vars, st_args, st_result} heaps=:{hp_type_heaps=type_heaps=:{th_vars}}
+			# (_,th_vars) = foldSt (\ {tv_info_ptr} (n, th_vars) -> (n+1, writePtr tv_info_ptr (TVI_GenTypeVarNumber n) th_vars)) st_vars (0,th_vars)
+			# heaps = {heaps & hp_type_heaps={type_heaps & th_vars=th_vars}}
+			# (arg_exprs, heaps) = mapSt make_expr1 st_args heaps
 			# (result_expr, heaps) = make_expr1 st_result heaps
-			= curry arg_exprs result_expr heaps  
+			# {hp_type_heaps=type_heaps=:{th_vars}} = heaps
+			# th_vars = foldSt (\ {tv_info_ptr} th_vars -> writePtr tv_info_ptr TVI_Empty th_vars) st_vars th_vars
+			# heaps = {heaps & hp_type_heaps={type_heaps & th_vars=th_vars}}
+			= curry arg_exprs result_expr heaps
 		where
 		
 			curry [] result_expr heaps 
@@ -755,18 +760,18 @@ where
 				# (arg_expr, heaps) = make_expr1 type heaps 
 				# (arrow_expr, heaps) = make_type_cons "(->)" heaps
 				= make_app arrow_expr arg_expr heaps
-			make_expr (CV {tv_ident} :@: arg_types) heaps
+			make_expr (CV {tv_info_ptr} :@: arg_types) heaps
 				# (arg_exprs, heaps) = mapSt make_expr1 arg_types heaps
-				# (tv_expr, heaps) = make_type_var tv_ident.id_name heaps					
+				# (tv_expr, heaps) = make_type_var tv_info_ptr heaps
 				= make_apps tv_expr arg_exprs heaps
 			make_expr (TB bt) heaps
 				= make_type_cons (toString bt) heaps	
-			make_expr (TV {tv_ident}) heaps 
-				= make_type_var tv_ident.id_name heaps 
-			make_expr (GTV {tv_ident}) heaps 
-				= make_type_var tv_ident.id_name heaps 
-			make_expr (TQV {tv_ident}) heaps 
-				= make_type_var tv_ident.id_name heaps
+			make_expr (TV {tv_info_ptr}) heaps 
+				= make_type_var tv_info_ptr heaps 
+			make_expr (GTV {tv_info_ptr}) heaps
+				= make_type_var tv_info_ptr heaps 
+			make_expr (TQV {tv_info_ptr}) heaps 
+				= make_type_var tv_info_ptr heaps
 			make_expr TE heaps
 				= make_type_cons "<error>" heaps	 
 			make_expr _ heaps 
@@ -781,10 +786,14 @@ where
 			make_type_cons name heaps
 				# name_expr = makeStringExpr name
 				= buildPredefConsApp PD_CGenTypeCons [name_expr] predefs heaps
-			make_type_var name heaps
-				# name_expr = makeStringExpr name
-				= buildPredefConsApp PD_CGenTypeVar [name_expr] predefs heaps									
+
+			make_type_var tv_info_ptr heaps
+				#! type_var_n = case sreadPtr tv_info_ptr heaps.hp_type_heaps.th_vars of
+									TVI_GenTypeVarNumber n -> n
+				= buildPredefConsApp PD_CGenTypeVar [makeIntExpr type_var_n] predefs heaps									
+
 			make_arrow x y heaps = buildPredefConsApp PD_CGenTypeArrow [x, y] predefs heaps
+
 			make_app x y heaps = buildPredefConsApp PD_CGenTypeApp [x, y] predefs heaps 	 
 
 	build_field_dsc group_index cons_dsc_ds field_dsc_ds {fs_ident, fs_index} (modules, heaps)
diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
index 71a68e4..71e3d06 100644
--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -1023,9 +1023,8 @@ cNonRecursiveAppl	:== False
 					| TVI_ConsInstance !DefinedSymbol //AA: generic cons instance function 
 					| TVI_Normalized !Int /* MV - position of type variable in its definition */
 					| TVI_Expr !Expression	/* AA: Expression corresponding to the type var during generic specialization */
-// MdM
-					| TVI_CPSTypeVar !CheatCompiler /* a pointer to a variable in CleanProverSystem is stored here, using a cast */
-// ... MdM
+					| TVI_GenTypeVarNumber !Int
+					| TVI_CPSTypeVar !CheatCompiler /* MdM: a pointer to a variable in CleanProverSystem is stored here, using a cast */
 
 ::	TypeVarInfoPtr	:== Ptr TypeVarInfo
 ::	TypeVarHeap 	:== Heap TypeVarInfo
-- 
cgit v1.2.3