Commit 19bf289a authored by John van Groningen's avatar John van Groningen
Browse files

use class_ident in typeToClass to prevent ';' after class name

when printing types, rename dtci_dclModule (was dtic_dclModule)
parent 4fe10343
...@@ -69,8 +69,21 @@ backEndInterface outputFileName commandLineArgs listTypes typesPath predef_symbo ...@@ -69,8 +69,21 @@ backEndInterface outputFileName commandLineArgs listTypes typesPath predef_symbo
# backEndFiles # backEndFiles
= BEFree backEnd backEndFiles = BEFree backEnd backEndFiles
= (backEndFiles == 0 && success, var_heap, attrHeap, errorFile, files) = (backEndFiles == 0 && success, var_heap, attrHeap, errorFile, files)
import typesupport import typesupport
:: DictionaryToClassInfo =
{ dtci_iclModuleIndex :: Int
, dtci_iclModule :: IclModule
, dtci_dclModules :: {#DclModule}
}
DictionaryToClassInfo iclModuleIndex iclModule dclModules :==
{ dtci_iclModuleIndex = iclModuleIndex
, dtci_iclModule = iclModule
, dtci_dclModules = dclModules
}
optionallyPrintFunctionTypes :: ListTypesOption {#Char} DictionaryToClassInfo {!Group} {#FunDef} *AttrVarHeap *Files !*BackEnd -> (*AttrVarHeap, *Files, *BackEnd) optionallyPrintFunctionTypes :: ListTypesOption {#Char} DictionaryToClassInfo {!Group} {#FunDef} *AttrVarHeap *Files !*BackEnd -> (*AttrVarHeap, *Files, *BackEnd)
optionallyPrintFunctionTypes {lto_listTypesKind, lto_showAttributes} typesPath info components functions attrHeap files backEnd optionallyPrintFunctionTypes {lto_listTypesKind, lto_showAttributes} typesPath info components functions attrHeap files backEnd
| lto_listTypesKind == ListTypesStrictExports || lto_listTypesKind == ListTypesAll | lto_listTypesKind == ListTypesStrictExports || lto_listTypesKind == ListTypesAll
...@@ -97,7 +110,7 @@ printFunctionTypes all attr info components functions attrHeap file backEnd ...@@ -97,7 +110,7 @@ printFunctionTypes all attr info components functions attrHeap file backEnd
printFunctionType :: Bool Bool DictionaryToClassInfo (Int, FunDef) (*AttrVarHeap, *File, *BackEnd) -> (*AttrVarHeap, *File, *BackEnd) printFunctionType :: Bool Bool DictionaryToClassInfo (Int, FunDef) (*AttrVarHeap, *File, *BackEnd) -> (*AttrVarHeap, *File, *BackEnd)
printFunctionType all attr info (functionIndex, {fun_ident,fun_type=Yes type}) (attrHeap, file, backEnd) printFunctionType all attr info (functionIndex, {fun_ident,fun_type=Yes type}) (attrHeap, file, backEnd)
| not all && functionIndex >= size info.dtic_dclModules.[info.dtci_iclModuleIndex].dcl_functions | not all && functionIndex >= size info.dtci_dclModules.[info.dtci_iclModuleIndex].dcl_functions
= (attrHeap, file, backEnd) = (attrHeap, file, backEnd)
// | trace_tn (toString fun_ident) && True ---> type.st_args // | trace_tn (toString fun_ident) && True ---> type.st_args
...@@ -325,18 +338,6 @@ markAttrVarCollected :: AttributeVar *AttrVarHeap -> *AttrVarHeap ...@@ -325,18 +338,6 @@ markAttrVarCollected :: AttributeVar *AttrVarHeap -> *AttrVarHeap
markAttrVarCollected {av_info_ptr} attrVarHeap markAttrVarCollected {av_info_ptr} attrVarHeap
= writePtr av_info_ptr AVI_Collected attrVarHeap = writePtr av_info_ptr AVI_Collected attrVarHeap
:: DictionaryToClassInfo =
{ dtci_iclModuleIndex :: Int
, dtci_iclModule :: IclModule
, dtic_dclModules :: {#DclModule}
}
DictionaryToClassInfo iclModuleIndex iclModule dclModules :==
{ dtci_iclModuleIndex = iclModuleIndex
, dtci_iclModule = iclModule
, dtic_dclModules = dclModules
}
dictionariesToClasses :: DictionaryToClassInfo SymbolType -> SymbolType dictionariesToClasses :: DictionaryToClassInfo SymbolType -> SymbolType
dictionariesToClasses info type=:{st_args, st_args_strictness, st_arity, st_context=[]} dictionariesToClasses info type=:{st_args, st_args_strictness, st_arity, st_context=[]}
# (reversedTypes, reversedContexts) # (reversedTypes, reversedContexts)
...@@ -388,12 +389,19 @@ where ...@@ -388,12 +389,19 @@ where
= {tc_class = TCClass klass, tc_types = [at_type \\ {at_type} <- args], tc_var = nilPtr} = {tc_class = TCClass klass, tc_types = [at_type \\ {at_type} <- args], tc_var = nilPtr}
typeToClass :: DictionaryToClassInfo TypeSymbIdent -> Optional (Global DefinedSymbol) typeToClass :: DictionaryToClassInfo TypeSymbIdent -> Optional (Global DefinedSymbol)
typeToClass info {type_ident, type_arity, type_index={glob_module, glob_object}} typeToClass {dtci_iclModuleIndex, dtci_iclModule, dtci_dclModules} {type_ident, type_arity, type_index={glob_module, glob_object}}
= case typeIndexToClassIndex info glob_module glob_object of #! nDclTypes = size dclModule.dcl_common.com_type_defs
Yes classIndex | glob_module <> dtci_iclModuleIndex || glob_object < nDclTypes
-> Yes {glob_module=glob_module, glob_object = {ds_ident = type_ident, ds_arity = type_arity, ds_index = glob_object}} # classIndex = glob_object - (nDclTypes - nDclClasses)
No | classIndex>=0
-> No # class_ident = dclModule.dcl_common.com_class_defs.[classIndex].class_ident
= Yes {glob_module=glob_module, glob_object = {ds_ident = class_ident, ds_arity = type_arity, ds_index = glob_object}}
= No
# classIndex = glob_object - (nIclTypes-nIclClasses)
| classIndex>=nDclClasses
# class_ident = dtci_iclModule.icl_common.com_class_defs.[classIndex].class_ident
= Yes {glob_module=glob_module, glob_object = {ds_ident = class_ident, ds_arity = type_arity, ds_index = glob_object}}
= No
where where
/* /*
This how the types are organised (#classes == #dictionaries) This how the types are organised (#classes == #dictionaries)
...@@ -410,33 +418,14 @@ typeToClass info {type_ident, type_arity, type_index={glob_module, glob_object}} ...@@ -410,33 +418,14 @@ typeToClass info {type_ident, type_arity, type_index={glob_module, glob_object}}
+-----------+------------------+-----------+------------------+ +-----------+------------------+-----------+------------------+
nDclTypes nIclTypes nDclTypes nIclTypes
*/ */
typeIndexToClassIndex :: DictionaryToClassInfo Int Int -> Optional Int dclModule
typeIndexToClassIndex {dtci_iclModuleIndex, dtci_iclModule, dtic_dclModules} moduleIndex typeIndex = dtci_dclModules.[glob_module]
| moduleIndex <> dtci_iclModuleIndex || typeIndex < nDclTypes nDclClasses
= toClassIndex typeIndex nDclTypes nDclClasses 0 = size dclModule.dcl_common.com_class_defs
// otherwise nIclTypes
= toClassIndex (typeIndex-nDclTypes) (nIclTypes-nDclTypes) (nIclClasses-nDclClasses) nDclClasses = size dtci_iclModule.icl_common.com_type_defs
where nIclClasses
dclModule = size dtci_iclModule.icl_common.com_class_defs
= dtic_dclModules.[moduleIndex]
nDclTypes
= size dclModule.dcl_common.com_type_defs
nDclClasses
= size dclModule.dcl_common.com_class_defs
nIclTypes
= size dtci_iclModule.icl_common.com_type_defs
nIclClasses
= size dtci_iclModule.icl_common.com_class_defs
toClassIndex :: Int Int Int Int -> Optional Int
toClassIndex typeIndex nTypes nClasses offset
| classIndex < 0
= No
// otherwise
= Yes (classIndex + offset)
where
classIndex
= typeIndex - (nTypes - nClasses)
copyInts :: !Int !Int -> {#Int} copyInts :: !Int !Int -> {#Int}
copyInts length cArray copyInts length cArray
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment