diff options
author | martijnv | 2002-01-17 10:13:08 +0000 |
---|---|---|
committer | martijnv | 2002-01-17 10:13:08 +0000 |
commit | 53c563fd380be4e7a8385a0b79a218bcba3dbc74 (patch) | |
tree | 02db013449408c0d42a7ade16e91424f2872087e | |
parent | Bug fix: Scopes in dynamics (diff) |
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
-rw-r--r-- | frontend/type_io_common.dcl | 7 | ||||
-rw-r--r-- | frontend/type_io_common.icl | 31 |
2 files changed, 36 insertions, 2 deletions
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 |