From 53c563fd380be4e7a8385a0b79a218bcba3dbc74 Mon Sep 17 00:00:00 2001
From: martijnv
Date: Thu, 17 Jan 2002 10:13:08 +0000
Subject: added a constructor and a destructor function for type string which
 contains a type name and a module name.

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@969 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
---
 frontend/type_io_common.dcl |  7 +++++++
 frontend/type_io_common.icl | 31 +++++++++++++++++++++++++++++--
 2 files changed, 36 insertions(+), 2 deletions(-)

(limited to 'frontend')

diff --git a/frontend/type_io_common.dcl b/frontend/type_io_common.dcl
index 8323901..8c2c9cc 100644
--- a/frontend/type_io_common.dcl
+++ b/frontend/type_io_common.dcl
@@ -8,6 +8,8 @@ import StdEnv
 import syntax
 import StdOverloaded
 
+APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES yes no :== yes
+
 /*
 // Priority
 PrioCode						:== toChar 0
@@ -66,3 +68,8 @@ UnderscoreSystemModule			:== "_system"		// implements the predefined module
 instance toString GlobalTCType
 
 instance toString BasicType
+
+create_type_string type_name module_name
+	:== type_name +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ module_name ) "")
+
+get_type_name_and_module_name_from_type_string :: !String -> (!String,!String)
diff --git a/frontend/type_io_common.icl b/frontend/type_io_common.icl
index f3a7ea7..a0f6292 100644
--- a/frontend/type_io_common.icl
+++ b/frontend/type_io_common.icl
@@ -67,9 +67,10 @@ UnderscoreSystemModule			:== "_system"		// implements the predefined module
 
 instance toString GlobalTCType
 where
-	toString (GTT_Basic basic_type)							= toString basic_type +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ PredefinedModuleName ) "")
+	toString (GTT_Basic basic_type)							= create_type_string (toString basic_type) PredefinedModuleName
 	toString GTT_Function									= " -> "
-	toString (GTT_Constructor type_symb_indent mod_name)	= type_symb_indent.type_name.id_name +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ mod_name) "")
+	toString (GTT_Constructor type_symb_indent mod_name)	= create_type_string type_symb_indent.type_name.id_name mod_name
+//	 +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ mod_name) "")
 
 instance toString BasicType
 where
@@ -81,3 +82,29 @@ where
 	toString BT_File		= "File"
 	toString BT_World		= "World"
 	toString (BT_String _)	= "String"
+
+create_type_string type_name module_name
+	:== type_name +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ module_name ) "")
+
+get_type_name_and_module_name_from_type_string :: !String -> (!String,!String)
+get_type_name_and_module_name_from_type_string type_string
+	#! (found_sep,sep_pos)
+		= CharIndex type_string 0 '\'' 
+	| found_sep
+		#! type_name
+			= type_string % (0,dec sep_pos)
+		#! module_name
+			= type_string % (inc sep_pos,dec (size type_string))
+		= (type_name,module_name)
+where 
+	CharIndex  :: !String !Int !Char -> (!Bool,!Int)
+	CharIndex s i char
+		| i == (size s)
+			= (False,size s)
+			
+			| i < (size s)
+				| s.[i] == char
+					= (True,i)
+					= CharIndex s (inc i) char;
+				= abort "CharIndex: index out of range"
+	
\ No newline at end of file
-- 
cgit v1.2.3