diff options
| author | ronny | 2003-05-16 09:59:19 +0000 |
|---|---|---|
| committer | ronny | 2003-05-16 09:59:19 +0000 |
| commit | d70d064e64fea680078f0248e6ddb8ece76e0cde (patch) | |
| tree | 0976d44630b049a5ddfb70de86b279d71435af17 | |
| parent | foldExp - added alternative for EE (diff) | |
renamed field names of type Ident in syntax tree
s/\<mod_name\>/mod_ident/g
s/\<ps_field_name\>/ps_field_ident/g
s/\<ps_selector_name\>/ps_selector_ident/g
s/\<pc_cons_name\>/pc_cons_ident/g
s/\<class_name\>/class_ident/g
s/\<gen_name\>/gen_ident/g
s/\<gen_member_name\>/gen_member_ident/g
s/\<gc_name\>/gc_ident/g
s/\<gc_gname\>/gc_gident/g
s/\<fs_name\>/fs_ident/g
s/\<td_name\>/td_ident/g
s/\<fv_name\>/fv_ident/g
s/\<var_name\>/var_ident/g
s/\<type_name\>/type_ident/g
s/\<symb_name\>/symb_ident/g
s/\<tv_name\>/tv_ident/g
s/\<av_name\>/av_ident/g
s/\<me_symb\>/me_ident/g
s/\<ft_symb\>/ft_ident/g
s/\<fun_symb\>/fun_ident/g
s/\<cons_symb\>/cons_ident/g
s/\<sd_symb\>/sd__ident/g
git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@1340 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
40 files changed, 1622 insertions, 1622 deletions
diff --git a/backend/backendconvert.icl b/backend/backendconvert.icl index af5ca46..c0ccef5 100644 --- a/backend/backendconvert.icl +++ b/backend/backendconvert.icl @@ -414,17 +414,17 @@ backEndConvertModulesH predefs {fe_icl = ( "dcl conversions" , currentDcl.dcl_conversions , "dcl constructors" - , [constructor.cons_symb.id_name \\ constructor <-: currentDcl.dcl_common.com_cons_defs] + , [constructor.cons_ident.id_name \\ constructor <-: currentDcl.dcl_common.com_cons_defs] , "dcl selectors" - , [selector.sd_symb.id_name \\ selector <-: currentDcl.dcl_common.com_selector_defs] + , [selector.sd__ident.id_name \\ selector <-: currentDcl.dcl_common.com_selector_defs] , "dcl types" - , [type.td_name.id_name \\ type <-: currentDcl.dcl_common.com_type_defs] + , [type.td_ident.id_name \\ type <-: currentDcl.dcl_common.com_type_defs] , "icl constructors" - , [constructor.cons_symb.id_name \\ constructor <-: icl_common.com_cons_defs] + , [constructor.cons_ident.id_name \\ constructor <-: icl_common.com_cons_defs] , "icl selectors" - , [selector.sd_symb.id_name \\ selector <-: icl_common.com_selector_defs] + , [selector.sd__ident.id_name \\ selector <-: icl_common.com_selector_defs] , "icl types" - , [type.td_name.id_name \\ type <-: icl_common.com_type_defs] + , [type.td_ident.id_name \\ type <-: icl_common.com_type_defs] ) */ #! backEnd @@ -539,7 +539,7 @@ where = foldStateWithIndexA (removeExpandedTypesFromFunType moduleIndex) dcl_functions where removeExpandedTypesFromFunType :: ModuleIndex Index FunType -> BackEnder - removeExpandedTypesFromFunType moduleIndex functionIndex {ft_symb, ft_type_ptr} + removeExpandedTypesFromFunType moduleIndex functionIndex {ft_ident, ft_type_ptr} = \be0 -> let (ft_type,be) = read_from_var_heap ft_type_ptr be0 in (case ft_type of VI_ExpandedType expandedType @@ -563,16 +563,16 @@ instance declareVars (Ptr VarInfo) where instance declareVars FreeVar where declareVars :: FreeVar !DeclVarsInput -> BackEnder declareVars freeVar _ - = declareVariable BELhsNodeId freeVar.fv_info_ptr freeVar.fv_name.id_name + = declareVariable BELhsNodeId freeVar.fv_info_ptr freeVar.fv_ident.id_name instance declareVars LetBind where declareVars :: LetBind !DeclVarsInput -> BackEnder declareVars {lb_src=App {app_symb, app_args=[Var _:_]}, lb_dst=freeVar} aliasDummyId - | not (isNilPtr app_symb.symb_name.id_info) && app_symb.symb_name==aliasDummyId + | not (isNilPtr app_symb.symb_ident.id_info) && app_symb.symb_ident==aliasDummyId = identity // we have an alias. Don't declare the same variable twice - = declareVariable BERhsNodeId freeVar.fv_info_ptr freeVar.fv_name.id_name + = declareVariable BERhsNodeId freeVar.fv_info_ptr freeVar.fv_ident.id_name declareVars {lb_dst=freeVar} _ - = declareVariable BERhsNodeId freeVar.fv_info_ptr freeVar.fv_name.id_name + = declareVariable BERhsNodeId freeVar.fv_info_ptr freeVar.fv_ident.id_name declareVariable :: Int (Ptr VarInfo) {#Char} -> BackEnder declareVariable lhsOrRhs varInfoPtr name @@ -614,7 +614,7 @@ instance declareVars Expression where = foldState declVar outParams where declVar {bind_dst=freeVar} - = declareVariable BERhsNodeId freeVar.fv_info_ptr freeVar.fv_name.id_name + = declareVariable BERhsNodeId freeVar.fv_info_ptr freeVar.fv_ident.id_name declareVars _ _ = identity @@ -666,7 +666,7 @@ declareFunctionSymbols functions functionIndices globalFunctions backEnd = foldl declare backEnd [(functionIndex, componentIndex, functions.[functionIndex]) \\ (componentIndex, functionIndex) <- functionIndices] where declare backEnd (functionIndex, componentIndex, function) - = appBackEnd (BEDeclareFunction (functionName function.fun_symb.id_name functionIndex globalFunctions) + = appBackEnd (BEDeclareFunction (functionName function.fun_ident.id_name functionIndex globalFunctions) function.fun_arity functionIndex componentIndex) backEnd where functionName :: {#Char} Int [IndexRange] -> {#Char} @@ -720,7 +720,7 @@ declareArrayInstances array_first_instance_indices /*{ir_from, ir_to}*/ predefs = declareArrayInstances (member_n+1) first_member_index backend declareArrayInstance :: Index FunDef -> BackEnder - declareArrayInstance index {fun_symb={id_name}, fun_type=Yes type} + declareArrayInstance index {fun_ident={id_name}, fun_type=Yes type} = beDeclareRuleType index main_dcl_module_n (id_name +++ ";" +++ toString index) o` beDefineRuleType index main_dcl_module_n (convertTypeAlt index main_dcl_module_n type) @@ -745,7 +745,7 @@ declareListInstances array_first_instance_indices predef_list_class_index predef = declareListInstances (member_n+1) first_member_index backend declareListInstance :: Index FunDef -> BackEnder - declareListInstance index {fun_symb={id_name}, fun_type=Yes type} + declareListInstance index {fun_ident={id_name}, fun_type=Yes type} // | trace_tn ("declareListInstance "+++toString index+++" "+++toString main_dcl_module_n) = beDeclareRuleType index main_dcl_module_n (id_name +++ ";" +++ toString index) o` beDefineRuleType index main_dcl_module_n (convertTypeAlt index main_dcl_module_n type) @@ -758,20 +758,20 @@ instance declare CommonDefs where instance declareWithIndex (TypeDef a) where declareWithIndex :: Index ModuleIndex (TypeDef a) -> BackEnder - declareWithIndex typeIndex moduleIndex {td_name} - = appBackEnd (BEDeclareType typeIndex moduleIndex td_name.id_name) + declareWithIndex typeIndex moduleIndex {td_ident} + = appBackEnd (BEDeclareType typeIndex moduleIndex td_ident.id_name) declareFunTypes :: ModuleIndex {#FunType} Int -> BackEnder declareFunTypes moduleIndex funTypes nrOfDclFunctions = foldStateWithIndexA (declareFunType moduleIndex nrOfDclFunctions) funTypes declareFunType :: ModuleIndex Index Int FunType -> BackEnder -declareFunType moduleIndex nrOfDclFunctions functionIndex {ft_symb, ft_type_ptr} +declareFunType moduleIndex nrOfDclFunctions functionIndex {ft_ident, ft_type_ptr} = \be0 -> let (vi,be) = read_from_var_heap ft_type_ptr be0 in (case vi of VI_ExpandedType expandedType - -> beDeclareRuleType functionIndex moduleIndex (functionName ft_symb.id_name functionIndex nrOfDclFunctions) -// -> beDeclareRuleType functionIndex moduleIndex (functionName moduleIndex ft_symb.id_name functionIndex nrOfDclFunctions) + -> beDeclareRuleType functionIndex moduleIndex (functionName ft_ident.id_name functionIndex nrOfDclFunctions) +// -> beDeclareRuleType functionIndex moduleIndex (functionName moduleIndex ft_ident.id_name functionIndex nrOfDclFunctions) o` beDefineRuleType functionIndex moduleIndex (convertTypeAlt functionIndex moduleIndex expandedType) _ -> identity) be @@ -809,17 +809,17 @@ convertTypeVars typeVars convertTypeVar :: ATypeVar -> BEMonad BETypeVarListP convertTypeVar typeVar - = beTypeVarListElem (beTypeVar typeVar.atv_variable.tv_name.id_name) (convertAttribution typeVar.atv_attribute) + = beTypeVarListElem (beTypeVar typeVar.atv_variable.tv_ident.id_name) (convertAttribution typeVar.atv_attribute) defineType :: ModuleIndex {#ConsDef} {#SelectorDef} Index CheckedTypeDef *BackEndState -> *BackEndState -defineType moduleIndex constructors _ typeIndex {td_name, td_attribute, td_args, td_rhs=AlgType constructorSymbols} be +defineType moduleIndex constructors _ typeIndex {td_ident, td_attribute, td_args, td_rhs=AlgType constructorSymbols} be # (flatType, be) = convertTypeLhs moduleIndex typeIndex td_attribute td_args be # (constructors, be) - = convertConstructors typeIndex td_name.id_name moduleIndex constructors constructorSymbols be + = convertConstructors typeIndex td_ident.id_name moduleIndex constructors constructorSymbols be = appBackEnd (BEAlgebraicType flatType constructors) be defineType moduleIndex constructors selectors typeIndex {td_attribute, td_args, td_rhs=RecordType {rt_constructor, rt_fields, rt_is_boxed_record}} be -// | trace_tn constructorDef.cons_symb +// | trace_tn constructorDef.cons_ident # (flatType, be) = convertTypeLhs moduleIndex typeIndex td_attribute td_args be # (fields, be) @@ -858,7 +858,7 @@ convertConstructors typeIndex typeName moduleIndex constructors symbols convertConstructor :: Int {#Char} ModuleIndex {#ConsDef} DefinedSymbol -> BEMonad BEConstructorListP convertConstructor typeIndex typeName moduleIndex constructorDefs {ds_index} = \be0 -> let (constructorType,be) = constructorTypeFunction be0 in - (appBackEnd (BEDeclareConstructor ds_index moduleIndex constructorDef.cons_symb.id_name) // +++ remove declare + (appBackEnd (BEDeclareConstructor ds_index moduleIndex constructorDef.cons_ident.id_name) // +++ remove declare o` beConstructor (beNormalTypeNode (beConstructorSymbol moduleIndex ds_index) @@ -870,9 +870,9 @@ convertConstructor typeIndex typeName moduleIndex constructorDefs {ds_index} = let (cons_type,be) = read_from_var_heap constructorDef.cons_type_ptr be0 in (case cons_type of VI_ExpandedType expandedType - -> (expandedType,be) // ->> (typeName, typeIndex, constructorDef.cons_symb.id_name, ds_index, expandedType) + -> (expandedType,be) // ->> (typeName, typeIndex, constructorDef.cons_ident.id_name, ds_index, expandedType) _ - -> (constructorDef.cons_type,be)) // ->> (typeName, typeIndex, constructorDef.cons_symb.id_name, ds_index, constructorDef.cons_type) + -> (constructorDef.cons_type,be)) // ->> (typeName, typeIndex, constructorDef.cons_ident.id_name, ds_index, constructorDef.cons_type) foldrAi function result array @@ -897,7 +897,7 @@ convertSelector :: ModuleIndex {#SelectorDef} Bool FieldSymbol -> BEMonad BEFiel //convertSelector moduleIndex selectorDefs {fs_index} convertSelector moduleIndex selectorDefs is_strict {fs_index} = \be0 -> let (selectorType,be) = selectorTypeFunction be0 in - ( appBackEnd (BEDeclareField fs_index moduleIndex selectorDef.sd_symb.id_name) + ( appBackEnd (BEDeclareField fs_index moduleIndex selectorDef.sd__ident.id_name) // o` beField fs_index moduleIndex (convertAnnotTypeNode (selectorType.st_result))) be o` beField fs_index moduleIndex (convertAnnotAndTypeNode (if is_strict AN_Strict AN_None) (selectorType.st_result))) be where @@ -1253,10 +1253,10 @@ convertRules rules main_dcl_module_n aliasDummyId be = convert t rulesP be convertRule :: Ident (Int,FunDef) Int -> BEMonad BEImpRuleP -convertRule aliasDummyId (index, {fun_type=Yes type, fun_body=body, fun_pos, fun_kind, fun_symb, fun_info}) main_dcl_module_n -// | trace_tn fun_symb.id_name +convertRule aliasDummyId (index, {fun_type=Yes type, fun_body=body, fun_pos, fun_kind, fun_ident, fun_info}) main_dcl_module_n +// | trace_tn fun_ident.id_name = beRule index (cafness fun_kind) - (convertTypeAlt index main_dcl_module_n (type -*-> ("convertRule", fun_symb.id_name, index, type, (fun_info.fi_group_index, body)))) + (convertTypeAlt index main_dcl_module_n (type -*-> ("convertRule", fun_ident.id_name, index, type, (fun_info.fi_group_index, body)))) (convertFunctionBody index (positionToLineNumber fun_pos) aliasDummyId body main_dcl_module_n) where cafness :: FunKind -> Int @@ -1376,7 +1376,7 @@ nextAttributeNumber state=:{bes_attr_number} = (bes_attr_number + BEFirstUniVarNumber, {state & bes_attr_number = bes_attr_number+1}) convertAttributeVar :: AttributeVar *BackEndState -> (BEAttribution, *BackEndState) -convertAttributeVar {av_info_ptr, av_name} state=:{bes_attr_number} +convertAttributeVar {av_info_ptr, av_ident} state=:{bes_attr_number} # (attrInfo, state) = read_from_attr_heap av_info_ptr state = case attrInfo of @@ -1447,8 +1447,8 @@ convertTypeNode (TA typeSymbolIdent typeArgs) convertTypeNode (TAS typeSymbolIdent typeArgs strictness) // = beNormalTypeNode (convertTypeSymbolIdent typeSymbolIdent) (convertTypeArgs typeArgs ) = beNormalTypeNode (convertTypeSymbolIdent typeSymbolIdent) (convertAnnotatedTypeArgs typeArgs strictness) -convertTypeNode (TV {tv_name}) - = beVarTypeNode tv_name.id_name +convertTypeNode (TV {tv_ident}) + = beVarTypeNode tv_ident.id_name convertTypeNode (TempQV n) = beVarTypeNode ("_tqv" +++ toString n) convertTypeNode (TempV n) @@ -1746,7 +1746,7 @@ collectNodeDefs aliasDummyId (Let {let_strict_binds, let_lazy_binds}) filterStrictAlias [] let_lazy_binds = let_lazy_binds filterStrictAlias [strict_bind=:{lb_src=App app}:strict_binds] let_lazy_binds - | not (isNilPtr app.app_symb.symb_name.id_info) && app.app_symb.symb_name==aliasDummyId + | not (isNilPtr app.app_symb.symb_ident.id_info) && app.app_symb.symb_ident==aliasDummyId // the compiled source was a strict alias like "#! x = y" = case hd app.app_args of Var _ diff --git a/backend/backendinterface.icl b/backend/backendinterface.icl index c479da3..7399fe4 100644 --- a/backend/backendinterface.icl +++ b/backend/backendinterface.icl @@ -96,14 +96,14 @@ printFunctionTypes all attr info components functions attrHeap file backEnd = flatten [[(componentIndex, member) \\ member <- group.group_members] \\ group <-: components & componentIndex <- [1..]] printFunctionType :: Bool Bool DictionaryToClassInfo (Int, FunDef) (*AttrVarHeap, *File, *BackEnd) -> (*AttrVarHeap, *File, *BackEnd) -printFunctionType all attr info (functionIndex, {fun_symb,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 = (attrHeap, file, backEnd) -// | trace_tn (toString fun_symb) && True ---> type.st_args +// | trace_tn (toString fun_ident) && True ---> type.st_args # (strictnessAdded, type, backEnd) - = addStrictnessFromBackEnd functionIndex fun_symb.id_name backEnd type + = addStrictnessFromBackEnd functionIndex fun_ident.id_name backEnd type | not strictnessAdded && not all = (attrHeap, file, backEnd) // FIXME: shouldn't have to repair the invariant here @@ -114,7 +114,7 @@ printFunctionType all attr info (functionIndex, {fun_symb,fun_type=Yes type}) (a # (type, attrHeap) = beautifulizeAttributes type attrHeap # file - = file <<< fun_symb <<< " :: " + = file <<< fun_ident <<< " :: " <:: ({ form_properties = (if attr cAttributed 0) bitor cAnnotated, form_attr_position = No }, type, Yes initialTypeVarBeautifulizer) <<< '\n' = (attrHeap, file, backEnd) @@ -388,10 +388,10 @@ where = {tc_class = TCClass klass, tc_types = [at_type \\ {at_type} <- args], tc_var = nilPtr} typeToClass :: DictionaryToClassInfo TypeSymbIdent -> Optional (Global DefinedSymbol) -typeToClass info {type_name, type_arity, type_index={glob_module, glob_object}} +typeToClass info {type_ident, type_arity, type_index={glob_module, glob_object}} = case typeIndexToClassIndex info glob_module glob_object of Yes classIndex - -> Yes {glob_module=glob_module, glob_object = {ds_ident = type_name, ds_arity = type_arity, ds_index = glob_object}} + -> Yes {glob_module=glob_module, glob_object = {ds_ident = type_ident, ds_arity = type_arity, ds_index = glob_object}} No -> No where diff --git a/backend/backendpreprocess.icl b/backend/backendpreprocess.icl index bc2e84b..0e81669 100644 --- a/backend/backendpreprocess.icl +++ b/backend/backendpreprocess.icl @@ -164,8 +164,8 @@ instance sequence LetBind where = sequence` app lb_dst where sequence` {app_symb, app_args} lb_dst sequenceState=:{ss_aliasDummyId} - | not (isNilPtr app_symb.symb_name.id_info) // nilPtr's are generated for Case's with case_ident=No in convertcases - && app_symb.symb_name==ss_aliasDummyId + | not (isNilPtr app_symb.symb_ident.id_info) // nilPtr's are generated for Case's with case_ident=No in convertcases + && app_symb.symb_ident==ss_aliasDummyId // the compiled source was a strict alias like "#! x = y" = case hd app_args of Var bound_var=:{var_info_ptr} diff --git a/frontend/StdCompare.icl b/frontend/StdCompare.icl index f902857..69a9773 100644 --- a/frontend/StdCompare.icl +++ b/frontend/StdCompare.icl @@ -224,12 +224,12 @@ where instance =< BoundVar where (=<) bv1 bv2 - = bv1.var_name =< bv2.var_name + = bv1.var_ident =< bv2.var_ident instance =< FreeVar where (=<) fv1 fv2 - = fv1.fv_name =< fv2.fv_name + = fv1.fv_ident =< fv2.fv_ident instance =< Ident where @@ -244,7 +244,7 @@ where instance =< TypeSymbIdent where (=<) s1 s2 - = s1.type_name =< s2.type_name + = s1.type_ident =< s2.type_ident instance =< Type where @@ -316,5 +316,5 @@ where instance < MemberDef where - (<) md1 md2 = md1.me_symb.id_name < md2.me_symb.id_name + (<) md1 md2 = md1.me_ident.id_name < md2.me_ident.id_name diff --git a/frontend/analtypes.icl b/frontend/analtypes.icl index bff03d7..99a446d 100644 --- a/frontend/analtypes.icl +++ b/frontend/analtypes.icl @@ -96,7 +96,7 @@ where = case td_rhs of SynType type # (opt_type, type_defs, type_heaps, error) - = try_to_expand_synonym_type (newPosition td.td_name td.td_pos) type td_attribute (type_defs, type_heaps, error) + = try_to_expand_synonym_type (newPosition td.td_ident td.td_pos) type td_attribute (type_defs, type_heaps, error) -> case opt_type of Yes type # type_defs = { type_defs & [gi_module, gi_index] = { td & td_rhs = SynType type}} @@ -120,18 +120,18 @@ where # (ok, subst_rhs, type_heaps) = substituteType used_td.td_attribute attribute used_td.td_args types at_type type_heaps | ok -> (Yes {type & at_type = subst_rhs }, type_defs, type_heaps, error) - # error = popErrorAdmin (typeSynonymError used_td.td_name "kind conflict in argument of type synonym" (pushErrorAdmin pos error)) + # error = popErrorAdmin (typeSynonymError used_td.td_ident "kind conflict in argument of type synonym" (pushErrorAdmin pos error)) -> (No, type_defs, type_heaps, error) _ -> (No, type_defs, type_heaps, error) try_to_expand_synonym_type_in_main_dcl main_dcl_module_index {gi_module,gi_index} (type_defs, main_dcl_type_defs, type_heaps, error) | main_dcl_module_index == main_dcl_module_index && gi_index < size main_dcl_type_defs - # (td=:{td_rhs,td_attribute,td_name,td_pos}, main_dcl_type_defs) = main_dcl_type_defs![gi_index] + # (td=:{td_rhs,td_attribute,td_ident,td_pos}, main_dcl_type_defs) = main_dcl_type_defs![gi_index] = case td_rhs of SynType type # (opt_type, type_defs, type_heaps, error) - = try_to_expand_synonym_type (newPosition td_name td_pos) type td_attribute (type_defs, type_heaps, error) + = try_to_expand_synonym_type (newPosition td_ident td_pos) type td_attribute (type_defs, type_heaps, error) -> case opt_type of Yes type -> (type_defs, { main_dcl_type_defs & [gi_index] = { td & td_rhs = SynType type}}, type_heaps, error) @@ -158,7 +158,7 @@ where partitionateTypeDef gi=:{gi_module,gi_index} pi=:{pi_type_defs} - # ({td_name,td_pos,td_used_types}, pi) = pi!pi_type_defs.[gi_module].[gi_index] + # ({td_ident,td_pos,td_used_types}, pi) = pi!pi_type_defs.[gi_module].[gi_index] pi = push_on_dep_stack gi pi (min_dep, pi) = foldSt visit_type td_used_types (cMAXINT, pi) = try_to_close_group gi min_dep pi @@ -195,13 +195,13 @@ where where check_cyclic_type_def td=:{gi_module,gi_index} (group, marks, typedefs, error) # (mark, marks) = marks![gi_module,gi_index] - # ({td_name,td_pos,td_used_types,td_rhs}, typedefs) = typedefs![gi_module].[gi_index] + # ({td_ident,td_pos,td_used_types,td_rhs}, typedefs) = typedefs![gi_module].[gi_index] | mark == cChecking - = (group, marks, typedefs, typeSynonymError td_name "cyclic dependency between type synonyms" error) + = (group, marks, typedefs, typeSynonymError td_ident "cyclic dependency between type synonyms" error) | mark < cMAXINT | is_synonym_type td_rhs # marks = { marks & [gi_module,gi_index] = cChecking } - error = pushErrorAdmin (newPosition td_name td_pos) error + error = pushErrorAdmin (newPosition td_ident td_pos) error (group, marks, typedefs, error) = check_cyclic_type_defs td_used_types [td : group] marks typedefs error error = popErrorAdmin error = (group, { marks & [gi_module,gi_index] = cMAXINT }, typedefs, error) @@ -373,8 +373,8 @@ where analTypes_for_TA :: Ident Int Int Int [AType] !Bool !{#CommonDefs} ![KindInfoPtr] !Conditions !*AnalyseState -> (!KindInfo, !TypeProperties, !(!Conditions, !*AnalyseState)) -analTypes_for_TA type_name glob_module glob_object type_arity types has_root_attr modules form_tvs conds as - # {td_arity, td_name} = modules.[glob_module].com_type_defs.[glob_object] +analTypes_for_TA type_ident glob_module glob_object type_arity types has_root_attr modules form_tvs conds as + # {td_arity, td_ident} = modules.[glob_module].com_type_defs.[glob_object] ({tdi_kinds, tdi_properties}, as) = as!as_td_infos.[glob_module].[glob_object] | type_arity <= td_arity # kind = kindArrowToKindInfo (drop type_arity tdi_kinds) @@ -384,8 +384,8 @@ analTypes_for_TA type_name glob_module glob_object type_arity types has_root_att # (type_properties, conds_as) = anal_types_of_type_cons modules form_tvs types tdi_kinds (conds, as) new_properties = condCombineTypeProperties has_root_attr type_properties tdi_properties = (kind, new_properties, conds_as) -// ---> ("analTypes_for_TA", td_name, type_properties, tdi_properties, new_properties, has_root_attr) - = (KI_Const, tdi_properties, (conds, { as & as_error = checkError type_name type_appl_error as.as_error })) +// ---> ("analTypes_for_TA", td_ident, type_properties, tdi_properties, new_properties, has_root_attr) + = (KI_Const, tdi_properties, (conds, { as & as_error = checkError type_ident type_appl_error as.as_error })) where anal_types_of_rec_type_cons modules form_tvs [] _ conds_as = (cIsHyperStrict, conds_as) @@ -421,10 +421,10 @@ instance analTypes Type where analTypes has_root_attr modules form_tvs (TV tv) conds_as = analTypes has_root_attr modules form_tvs tv conds_as - analTypes has_root_attr modules form_tvs type=:(TA {type_name,type_index={glob_module,glob_object},type_arity} types) (conds, as) - = analTypes_for_TA type_name glob_module glob_object type_arity types has_root_attr modules form_tvs conds as - analTypes has_root_attr modules form_tvs type=:(TAS {type_name,type_index={glob_module,glob_object},type_arity} types _) (conds, as) - = analTypes_for_TA type_name glob_module glob_object type_arity types has_root_attr modules form_tvs conds as + analTypes has_root_attr modules form_tvs type=:(TA {type_ident,type_index={glob_module,glob_object},type_arity} types) (conds, as) + = analTypes_for_TA type_ident glob_module glob_object type_arity types has_root_attr modules form_tvs conds as + analTypes has_root_attr modules form_tvs type=:(TAS {type_ident,type_index={glob_module,glob_object},type_arity} types _) (conds, as) + = analTypes_for_TA type_ident glob_module glob_object type_arity types has_root_attr modules form_tvs conds as analTypes has_root_attr modules form_tvs (arg_type --> res_type) conds_as # (arg_kind, arg_type_props, conds_as) = analTypes has_root_attr modules form_tvs arg_type conds_as (res_kind, res_type_props, (conds, as=:{as_kind_heap,as_error})) = analTypes has_root_attr modules form_tvs res_type conds_as @@ -582,8 +582,8 @@ where anal_type_def modules gi=:{gi_module,gi_index} (group_properties, conds, as=:{as_error}) # {com_type_defs,com_cons_defs} = modules.[gi_module] - {td_name,td_pos,td_args,td_rhs} = com_type_defs.[gi_index] - as_error = pushErrorAdmin (newPosition td_name td_pos) as_error + {td_ident,td_pos,td_args,td_rhs} = com_type_defs.[gi_index] + as_error = pushErrorAdmin (newPosition td_ident td_pos) as_error (type_properties, (conds, as)) = anal_rhs_of_type_def modules com_cons_defs td_rhs (conds, { as & as_error = as_error }) = (combineTypeProperties group_properties type_properties, conds, {as & as_error = popErrorAdmin as.as_error }) where @@ -654,8 +654,8 @@ where update_type_def_info modules type_properties top_vars {gi_module,gi_index} updated_kinds (kind_store, kind_heap, td_infos) // # {com_type_defs} = modules.[gi_module] -// {td_name} = com_type_defs.[gi_index] - # (td_info=:{tdi_kinds}, td_infos) = td_infos![gi_module].[gi_index] // ---> ("update_type_def_info", td_name, type_properties) +// {td_ident} = com_type_defs.[gi_index] + # (td_info=:{tdi_kinds}, td_infos) = td_infos![gi_module].[gi_index] // ---> ("update_type_def_info", td_ident, type_properties) # (group_vars, cons_vars, kind_store, kind_heap) = determine_type_def_info tdi_kinds updated_kinds top_vars kind_store kind_heap = (kind_store, kind_heap, { td_infos & [gi_module,gi_index] = {td_info & tdi_properties = type_properties, tdi_kinds = updated_kinds, tdi_group_vars = group_vars, tdi_cons_vars = cons_vars }}) @@ -681,12 +681,12 @@ where check_dcl_properties modules dcl_types dcl_mod_index properties {gi_module, gi_index} as | gi_module == dcl_mod_index && gi_index < size dcl_types - # {td_name, td_rhs, td_args, td_pos} = dcl_types.[gi_index] + # {td_ident, td_rhs, td_args, td_pos} = dcl_types.[gi_index] = case td_rhs of AbstractType spec_properties - # as_error = pushErrorAdmin (newPosition td_name td_pos) as.as_error + # as_error = pushErrorAdmin (newPosition td_ident td_pos) as.as_error | check_coercibility spec_properties properties -// ---> ("check_coercibility", td_name, spec_properties, properties) +// ---> ("check_coercibility", td_ident, spec_properties, properties) |check_hyperstrictness spec_properties properties | spec_properties bitand cIsNonCoercible == 0 # (as_type_var_heap, as_td_infos, as_error) = check_positive_sign gi_module gi_index modules td_args as.as_type_var_heap as.as_td_infos as_error @@ -793,10 +793,10 @@ where determine_kinds_of_class modules class_module class_index (class_infos, as) | isEmpty class_infos.[class_module,class_index] # {com_class_defs,com_member_defs} = modules.[class_module] - {class_args,class_context,class_members,class_arity,class_pos,class_name} = com_class_defs.[class_index] + {class_args,class_context,class_members,class_arity,class_pos,class_ident} = com_class_defs.[class_index] (class_kind_vars, as_kind_heap) = fresh_kind_vars class_arity [] as.as_kind_heap as_type_var_heap = bind_kind_vars class_args class_kind_vars as.as_type_var_heap - as_error = pushErrorAdmin (newPosition class_name class_pos) as.as_error + as_error = pushErrorAdmin (newPosition class_ident class_pos) as.as_error class_infos = { class_infos & [class_module,class_index] = cyclicClassInfoMark } (class_infos, as) = determine_kinds_of_context_classes class_context (class_infos, { as & as_kind_heap = as_kind_heap, as_type_var_heap = as_type_var_heap, as_error = as_error }) @@ -805,12 +805,12 @@ where (class_infos, as) = determine_kinds_of_members modules class_members com_member_defs class_kind_vars (class_infos, as) (class_kinds, as_kind_heap) = retrieve_class_kinds class_kind_vars as.as_kind_heap = ({class_infos & [class_module,class_index] = class_kinds }, { as & as_kind_heap = as_kind_heap, as_error = popErrorAdmin as.as_error}) -// ---> ("determine_kinds_of_class", class_name, class_kinds) +// ---> ("determine_kinds_of_class", class_ident, class_kinds) = ({class_infos & [class_module,class_index] = [ KindConst \\ _ <- [1..class_arity]] }, { as & as_error = popErrorAdmin as.as_error }) | isCyclicClass class_infos.[class_module,class_index] - # {class_name,class_arity} = modules.[class_module].com_class_defs.[class_index] + # {class_ident,class_arity} = modules.[class_module].com_class_defs.[class_index] = ({ class_infos & [class_module,class_index] = [ KindConst \\ _ <- [1..class_arity]]}, - { as & as_error = checkError class_name class_def_error as.as_error }) + { as & as_error = checkError class_ident class_def_error as.as_error }) = (class_infos, as) where fresh_kind_vars nr_of_vars fresh_vars kind_heap @@ -948,8 +948,8 @@ where = check_kinds_of_generics common_defs (inc index) generic_defs class_infos gen_heap as where check_kinds_of_generic :: !{#CommonDefs} !GenericDef !*ClassDefInfos !*GenericHeap !*AnalyseState -> (!*ClassDefInfos, !*GenericHeap, !*AnalyseState) - check_kinds_of_generic common_defs {gen_type, gen_name, gen_pos, gen_vars, gen_info_ptr} class_infos gen_heap as - # as = {as & as_error = pushErrorAdmin (newPosition gen_name gen_pos) as.as_error} + check_kinds_of_generic common_defs {gen_type, gen_ident, gen_pos, gen_vars, gen_info_ptr} class_infos gen_heap as + # as = {as & as_error = pushErrorAdmin (newPosition gen_ident gen_pos) as.as_error} # (class_infos, as) = check_kinds_of_symbol_type common_defs gen_type class_infos as # (kinds, as) = mapSt retrieve_tv_kind gen_type.st_vars as # as = check_kinds_of_generic_vars (take (length gen_vars) kinds) as @@ -998,11 +998,11 @@ where = as check_kinds_of_icl_fuction common_defs fun_index (icl_fun_defs, class_infos, expression_heap, as) - # ({fun_type,fun_symb,fun_info,fun_pos}, icl_fun_defs) = icl_fun_defs![fun_index] + # ({fun_type,fun_ident,fun_info,fun_pos}, icl_fun_defs) = icl_fun_defs![fun_index] (expression_heap, as) = check_kinds_of_dynamics common_defs fun_info.fi_dynamics expression_heap as = case fun_type of Yes symbol_type - # as_error = pushErrorAdmin (newPosition fun_symb fun_pos) as.as_error + # as_error = pushErrorAdmin (newPosition fun_ident fun_pos) as.as_error (class_infos, as) = check_kinds_of_symbol_type common_defs symbol_type class_infos { as & as_error = as_error } -> (icl_fun_defs, class_infos, expression_heap, { as & as_error = popErrorAdmin as.as_error }) No @@ -1015,8 +1015,8 @@ where = (dcl_modules, class_infos, as) where check_kinds_of_dcl_fuction common_defs dcl_functions fun_index (class_infos, as) - # {ft_type,ft_symb,ft_pos} = dcl_functions.[fun_index] - as_error = pushErrorAdmin (newPosition ft_symb ft_pos) as.as_error + # {ft_type,ft_ident,ft_pos} = dcl_functions.[fun_index] + as_error = pushErrorAdmin (newPosition ft_ident ft_pos) as.as_error (class_infos, as) = check_kinds_of_symbol_type common_defs ft_type class_infos { as & as_error = as_error } = (class_infos, { as & as_error = popErrorAdmin as.as_error}) @@ -1073,13 +1073,13 @@ where checkLeftRootAttributionOfTypeDef :: !{# CommonDefs} GlobalIndex !(!*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin) -> (!*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin) checkLeftRootAttributionOfTypeDef common_defs {gi_module,gi_index} (td_infos, th_vars, error) - # {td_rhs, td_attribute, td_name, td_pos} = common_defs.[gi_module].com_type_defs.[gi_index] + # {td_rhs, td_attribute, td_ident, td_pos} = common_defs.[gi_module].com_type_defs.[gi_index] | isUniqueAttr td_attribute = (td_infos, th_vars, error) # (is_unique, (td_infos, th_vars)) = isUniqueTypeRhs common_defs gi_module td_rhs (td_infos, th_vars) | is_unique - = (td_infos, th_vars, checkErrorWithIdentPos (newPosition td_name td_pos) + = (td_infos, th_vars, checkErrorWithIdentPos (newPosition td_ident td_pos) " left root * attribute expected" error) = (td_infos, th_vars, error) diff --git a/frontend/analunitypes.icl b/frontend/analunitypes.icl index ab0b524..53e5541 100644 --- a/frontend/analunitypes.icl +++ b/frontend/analunitypes.icl @@ -29,7 +29,7 @@ typeProperties type_index module_index hio_signs hio_props defs type_var_heap td (tsp_propagation, type_var_heap, td_infos) = determinePropClassOfTypeDef type_index module_index td_info hio_props defs type_var_heap td_infos tsp_coercible = (td_info.tdi_properties bitand cIsNonCoercible) == 0 = ({tsp_sign = tsp_sign, tsp_propagation = tsp_propagation, tsp_coercible = tsp_coercible }, type_var_heap, td_infos) -// ---> ("typeProperties", (defs.[module_index].com_type_defs.[type_index].td_name, type_index, module_index), tsp_sign, tsp_propagation) +// ---> ("typeProperties", (defs.[module_index].com_type_defs.[type_index].td_ident, type_index, module_index), tsp_sign, tsp_propagation) signClassification :: !Index !Index ![SignClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos -> (!SignClassification, !*TypeVarHeap, !*TypeDefInfos) @@ -38,7 +38,7 @@ signClassification type_index module_index hio_signs defs type_var_heap td_infos # (tsp_sign, type_var_heap, td_infos) = determineSignClassOfTypeDef type_index module_index td_info hio_signs defs type_var_heap td_infos = (tsp_sign, type_var_heap, td_infos) -// ---> ("signClassification", defs.[module_index].com_type_defs.[type_index].td_name, tsp_sign) +// ---> ("signClassification", defs.[module_index].com_type_defs.[type_index].td_ident, tsp_sign) removeTopClasses [cv : cvs] [tc : tcs] @@ -131,8 +131,8 @@ where where collect_sign_class_of_type_def group_nr signs_of_group_vars ci {gi_module,gi_index} (sign_requirements, type_var_heap, td_infos) # ({tdi_group_vars,tdi_kinds,tdi_index_in_group},td_infos) = td_infos![gi_module].[gi_index] - {td_name,td_args,td_rhs} = ci.[gi_module].com_type_defs.[gi_index] -// (rev_hio_signs, type_var_heap) = bind_type_vars_to_signs td_args (tdi_group_vars ---> ("bind_type_vars_to_signs",td_name, tdi_group_vars)) tdi_kinds signs_of_group_vars ([], type_var_heap) + {td_ident,td_args,td_rhs} = ci.[gi_module].com_type_defs.[gi_index] +// (rev_hio_signs, type_var_heap) = bind_type_vars_to_signs td_args (tdi_group_vars ---> ("bind_type_vars_to_signs",td_ident, tdi_group_vars)) tdi_kinds signs_of_group_vars ([], type_var_heap) (rev_hio_signs, type_var_heap) = bind_type_vars_to_signs td_args tdi_group_vars tdi_kinds signs_of_group_vars ([], type_var_heap) (sign_env, scs) = sign_class_of_type_def gi_module td_rhs group_nr ci {scs_type_var_heap = type_var_heap, scs_type_def_infos = td_infos, scs_rec_appls = [] } @@ -222,7 +222,7 @@ IsArrowKind (KindArrow _) = True IsArrowKind _ = False signClassOfTypeVariable :: !TypeVar !{#CommonDefs} !*SignClassState -> (!SignClassification,!SignClassification,!*SignClassState) -signClassOfTypeVariable {tv_name,tv_info_ptr} ci scs=:{scs_type_var_heap} +signClassOfTypeVariable {tv_ident,tv_info_ptr} ci scs=:{scs_type_var_heap} # (var_info, scs_type_var_heap) = readPtr tv_info_ptr scs_type_var_heap scs = { scs & scs_type_var_heap = scs_type_var_heap } = case var_info of @@ -243,7 +243,7 @@ signClassOfType_for_TA glob_module glob_object types sign use_top_sign group_nr # (td_info=:{tdi_group_nr,tdi_index_in_group,tdi_kinds}, scs) = scs!scs_type_def_infos.[glob_module].[glob_object] | tdi_group_nr == group_nr = sign_class_of_type_list_of_rec_type types sign use_top_sign tdi_index_in_group ci [] scs - # {td_arity,td_name} = ci.[glob_module].com_type_defs.[glob_object] + # {td_arity,td_ident} = ci.[glob_module].com_type_defs.[glob_object] (sign_classes, hio_signs, scs) = collect_sign_classes_of_type_list types tdi_kinds group_nr ci scs (type_class, scs_type_var_heap, scs_type_def_infos) = determineSignClassOfTypeDef glob_object glob_module td_info hio_signs ci scs.scs_type_var_heap scs.scs_type_def_infos @@ -327,7 +327,7 @@ propClassification type_index module_index hio_props defs type_var_heap td_infos # (tsp_prop, type_var_heap, td_infos) = determinePropClassOfTypeDef type_index module_index td_info hio_props defs type_var_heap td_infos = (tsp_prop, type_var_heap, td_infos) -// ---> ("propClassification", defs.[module_index].com_type_defs.[type_index].td_name, tsp_prop) +// ---> ("propClassification", defs.[module_index].com_type_defs.[type_index].td_ident, tsp_prop) determinePropClassOfTypeDef :: !Int !Int !TypeDefInfo ![PropClassification] !{# CommonDefs} !*TypeVarHeap !*TypeDefInfos -> (!PropClassification,!*TypeVarHeap, !*TypeDefInfos) @@ -406,7 +406,7 @@ where where collect_sign_class_of_type_def group_nr props_of_group_vars ci {gi_module,gi_index} (prop_requirements, type_var_heap, td_infos) # ({tdi_group_vars,tdi_kinds,tdi_index_in_group},td_infos) = td_infos![gi_module].[gi_index] - {td_name,td_args,td_rhs} = ci.[gi_module].com_type_defs.[gi_index] + {td_ident,td_args,td_rhs} = ci.[gi_module].com_type_defs.[gi_index] (rev_hio_props, type_var_heap) = bind_type_vars_to_props td_args tdi_group_vars tdi_kinds props_of_group_vars ([], type_var_heap) (prop_env, pcs) = prop_class_of_type_def gi_module td_rhs group_nr ci {pcs_type_var_heap = type_var_heap, pcs_type_def_infos = td_infos, pcs_rec_appls = [] } diff --git a/frontend/check.icl b/frontend/check.icl index 32c1bdd..4b6cc0c 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -42,8 +42,8 @@ where check_generic index mod_index gen_defs type_defs class_defs modules heaps cs - #(gen_def=:{gen_name, gen_pos}, gen_defs) = gen_defs ! [index] - # cs = pushErrorAdmin (newPosition gen_name gen_pos) cs + #(gen_def=:{gen_ident, gen_pos}, gen_defs) = gen_defs ! [index] + # cs = pushErrorAdmin (newPosition gen_ident gen_pos) cs # (gen_def, heaps) = alloc_gen_info gen_def heaps @@ -56,7 +56,7 @@ where # (cs=:{cs_x}) = popErrorAdmin cs #! cs = { cs & cs_x = {cs_x & x_needed_modules = cs_x.x_needed_modules bitor cNeedStdGeneric}} = (gen_defs, type_defs, class_defs, modules, heaps, cs) - //---> ("check_generic", gen_name, gen_def.gen_vars, gen_def.gen_type) + //---> ("check_generic", gen_ident, gen_def.gen_vars, gen_def.gen_type) alloc_gen_info gen_def heaps=:{hp_generic_heap} # initial_info = @@ -76,16 +76,16 @@ where #! th_vars = performOnTypeVars initializeToTVI_Empty types th_vars = ({heaps & hp_type_heaps={hp_type_heaps&th_vars=th_vars}}, cs) where - mark_var _ {tv_name,tv_info_ptr} th_vars + mark_var _ {tv_ident,tv_info_ptr} th_vars = writePtr tv_info_ptr TVI_Used th_vars - check_var_marked {tv_name,tv_info_ptr} (th_vars,cs=:{cs_error}) + check_var_marked {tv_ident,tv_info_ptr} (th_vars,cs=:{cs_error}) #! (tv_info, th_vars) = readPtr tv_info_ptr th_vars #! cs_error = case tv_info of - TVI_Empty -> checkError tv_name "generic variable not used" cs_error + TVI_Empty -> checkError tv_ident "generic variable not used" cs_error TVI_Used -> cs_error = (th_vars, {cs & cs_error = cs_error}) - check_generic_type gen_def=:{gen_type, gen_vars, gen_name, gen_pos} module_index type_defs class_defs modules heaps=:{hp_type_heaps} cs + check_generic_type gen_def=:{gen_type, gen_vars, gen_ident, gen_pos} module_index type_defs class_defs modules heaps=:{hp_type_heaps} cs #! (checked_gen_type, _, type_defs, class_defs, modules, hp_type_heaps, cs) = checkFunctionType module_index gen_type SP_None type_defs class_defs modules hp_type_heaps cs @@ -112,9 +112,9 @@ where = gen_vars ++ (removeMembers st_vars gen_vars) check_generic_var gv (acc_gvs, [], error) - = (acc_gvs, [], checkError gv.tv_name "generic variable not used" error) + = (acc_gvs, [], checkError gv.tv_ident "generic variable not used" error) check_generic_var gv (acc_gvs, [tv:tvs], error) - | gv.tv_name.id_name == tv.tv_name.id_name + | gv.tv_ident.id_name == tv.tv_ident.id_name = ([tv:acc_gvs], tvs, error) # (acc_gvs, tvs, error) = check_generic_var gv (acc_gvs, tvs, error) = (acc_gvs, [tv:tvs], error) @@ -129,7 +129,7 @@ where add_var_to_symbol_table :: !TypeVar !(![TypeVar], !*SymbolTable, !*TypeVarHeap, !*ErrorAdmin) -> (![TypeVar],!*SymbolTable,!*TypeVarHeap,!*ErrorAdmin) - add_var_to_symbol_table tv=:{tv_name={id_name,id_info}} (rev_class_args, symbol_table, th_vars, error) + add_var_to_symbol_table tv=:{tv_ident={id_name,id_info}} (rev_class_args, symbol_table, th_vars, error) #! (entry, symbol_table) = readPtr id_info symbol_table | entry.ste_kind == STE_Empty || entry.ste_def_level < cGlobalScope # (new_var_ptr, th_vars) = newPtr TVI_Empty th_vars @@ -141,7 +141,7 @@ where remove_vars_from_symbol_table rev_gen_vars cs=:{cs_symbol_table} #! (gen_vars, cs_symbol_table) = foldSt remove_var_from_symbol_table rev_gen_vars ([], cs_symbol_table) = (gen_vars, { cs & cs_symbol_table = cs_symbol_table}) - remove_var_from_symbol_table tv=:{tv_name={id_name,id_info}} (gen_vars, symbol_table) + remove_var_from_symbol_table tv=:{tv_ident={id_name,id_info}} (gen_vars, symbol_table) #! (entry, symbol_table) = readPtr id_info symbol_table #! symbol_table = writePtr id_info entry.ste_previous symbol_table =([tv:gen_vars], symbol_table) @@ -161,7 +161,7 @@ where = foldSt (write_type_var_info TVI_Used) gen_vars th_vars clear_type_vars gen_vars th_vars = foldSt (write_type_var_info TVI_Empty) gen_vars th_vars - write_type_var_info tvi {tv_name, tv_info_ptr} th_vars + write_type_var_info tvi {tv_ident, tv_info_ptr} th_vars = writePtr tv_info_ptr tvi th_vars check_type_vars_not_used :: ![TypeContext] !*TypeVarHeap !*ErrorAdmin -> (!*TypeVarHeap, !*ErrorAdmin) @@ -169,13 +169,13 @@ where # types = flatten [tc_types \\ {tc_types} <- contexts] # atypes = [{at_type=t,at_attribute=TA_None} \\ t <- types] = performOnTypeVars check_type_var_not_used atypes (th_vars, cs_error) - check_type_var_not_used attr tv=:{tv_name, tv_info_ptr} (th_vars, cs_error) + check_type_var_not_used attr tv=:{tv_ident, tv_info_ptr} (th_vars, cs_error) #! (tv_info, th_vars) = readPtr tv_info_ptr th_vars = case tv_info of TVI_Empty -> (th_vars, cs_error) TVI_Used - #! cs_error = checkError tv_name "context restrictions on generic variables are not allowed" cs_error + #! cs_error = checkError tv_ident "context restrictions on generic variables are not allowed" cs_error -> (th_vars, cs_error) _ -> abort ("check_no_generic_vars_in_contexts: wrong TVI" ---> (tv, tv_info)) @@ -194,14 +194,14 @@ where check_instance index mod_index gen_case_defs generic_defs type_defs modules heaps cs - #! (case_def=:{gc_name,gc_gname,gc_pos,gc_type}, gen_case_defs) = gen_case_defs ! [index] + #! (case_def=:{gc_ident,gc_gident,gc_pos,gc_type}, gen_case_defs) = gen_case_defs ! [index] - #! cs = pushErrorAdmin (newPosition gc_name gc_pos) cs + #! cs = pushErrorAdmin (newPosition gc_ident gc_pos) cs #! (gc_type, gc_type_cons, type_defs, modules, heaps, cs) = check_instance_type mod_index gc_type type_defs modules heaps cs - #! (generic_gi, cs) = get_generic_index gc_gname mod_index cs + #! (generic_gi, cs) = get_generic_index gc_gident mod_index cs | not cs.cs_error.ea_ok # cs = popErrorAdmin cs = (gen_case_defs, generic_defs, type_defs, modules, heaps, cs) @@ -223,15 +223,15 @@ where #! (cs=:{cs_x}) = popErrorAdmin cs #! cs = { cs & cs_x = {cs_x & x_needed_modules = cs_x.x_needed_modules bitor cNeedStdGeneric}} = (gen_case_defs, generic_defs, type_defs, modules, heaps, cs) - //---> ("check_generic_case", gc_name, gc_type_cons) + //---> ("check_generic_case", gc_ident, gc_type_cons) check_instance_type module_index (TA type_cons []) type_defs modules heaps=:{hp_type_heaps} cs - # (entry, cs_symbol_table) = readPtr type_cons.type_name.id_info cs.cs_symbol_table + # (entry, cs_symbol_table) = readPtr type_cons.type_ident.id_info cs.cs_symbol_table # cs = {cs & cs_symbol_table = cs_symbol_table} # (type_index, type_module) = retrieveGlobalDefinition entry STE_Type module_index | type_index == NotFound - # cs_error = checkError type_cons.type_name "generic argument type undefined" cs.cs_error + # cs_error = checkError type_cons.type_ident "generic argument type undefined" cs.cs_error = (TA type_cons [], TypeConsSymb type_cons, type_defs, modules,{heaps&hp_type_heaps = hp_type_heaps}, {cs&cs_error=cs_error}) # (type_def, type_defs, modules) = getTypeDef module_index {glob_module=type_module, glob_object=type_index} type_defs modules @@ -281,10 +281,10 @@ where = { heaps & hp_generic_heap = writePtr gen_info_ptr info hp_generic_heap} check_star_case :: !TypeCons !GenericDef !GlobalIndex !*Heaps !*CheckState -> (!*Heaps, !*CheckState) - check_star_case (TypeConsVar _) {gen_name, gen_info_ptr} index heaps=:{hp_generic_heap} cs=:{cs_error} + check_star_case (TypeConsVar _) {gen_ident, gen_info_ptr} index heaps=:{hp_generic_heap} cs=:{cs_error} # (info=:{gen_star_case}, hp_generic_heap) = readPtr gen_info_ptr hp_generic_heap | gen_star_case.gi_module <> NoIndex - # cs_error = checkError gen_name "general kind-* case is already defined" cs_error + # cs_error = checkError gen_ident "general kind-* case is already defined" cs_error = ({ heaps & hp_generic_heap = hp_generic_heap}, {cs & cs_error = cs_error}) # info = { info & gen_star_case = index } # hp_generic_heap = writePtr gen_info_ptr info hp_generic_heap @@ -306,8 +306,8 @@ checkTypeClasses module_index opt_icl_info class_defs member_defs type_defs modu where check_type_class module_index opt_icl_info class_index (class_defs, member_defs, type_defs, modules, type_heaps, cs=:{cs_symbol_table,cs_error}) | has_to_be_checked module_index opt_icl_info class_index - # (class_def=:{class_name,class_pos,class_args,class_context,class_members}, class_defs) = class_defs![class_index] - cs = {cs & cs_error = setErrorAdmin (newPosition class_name class_pos) cs_error } + # (class_def=:{class_ident,class_pos,class_args,class_context,class_members}, class_defs) = class_defs![class_index] + cs = {cs & cs_error = setErrorAdmin (newPosition class_ident class_pos) cs_error } (class_args, class_context, type_defs, class_defs, modules, type_heaps, cs) = checkSuperClasses class_args class_context module_index type_defs class_defs modules type_heaps cs class_defs = { class_defs & [class_index] = { class_def & class_context = class_context, class_args = class_args }} @@ -353,9 +353,9 @@ where -> (!Index, ![FunType], ![FunType],!v:{#CheckedTypeDef}, !x:{#ClassDef}, !v:{#DclModule}, !*Heaps, !*CheckState) check_dcl_functions module_index [] fun_index next_inst_index collected_funtypes collected_instances type_defs class_defs modules heaps cs = (next_inst_index, collected_funtypes, collected_instances, type_defs, class_defs, modules, heaps, cs) - check_dcl_functions module_index [fun_type=:{ft_symb,ft_type,ft_pos,ft_specials} : fun_types] fun_index + check_dcl_functions module_index [fun_type=:{ft_ident,ft_type,ft_pos,ft_specials} : fun_types] fun_index next_inst_index collected_funtypes collected_instances type_defs class_defs modules heaps cs - # position = newPosition ft_symb ft_pos + # position = newPosition ft_ident ft_pos cs = { cs & cs_error = setErrorAdmin position cs.cs_error } (ft_type, ft_specials, type_defs, class_defs, modules, hp_type_heaps, cs) = checkFunctionType module_index ft_type ft_specials type_defs class_defs modules heaps.hp_type_heaps cs @@ -422,9 +422,9 @@ checkMemberTypes module_index opt_icl_info member_defs type_defs class_defs modu = (mds,tds,cds,modules,{heaps & hp_type_heaps = hp_type_heaps,hp_var_heap = hp_var_heap},cs) where check_class_member module_index opt_icl_info member_index (member_defs, type_defs, class_defs, modules, type_heaps, var_heap, cs) - # (member_def=:{me_symb,me_type,me_pos,me_class}, member_defs) = member_defs![member_index] + # (member_def=:{me_ident,me_type,me_pos,me_class}, member_defs) = member_defs![member_index] | has_to_be_checked opt_icl_info me_class - # position = newPosition me_symb me_pos + # position = newPosition me_ident me_pos cs = { cs & cs_error = setErrorAdmin position cs.cs_error } (me_type, type_defs, class_defs, modules, type_heaps, cs) = checkMemberType module_index me_type type_defs class_defs modules type_heaps cs @@ -465,7 +465,7 @@ where check_instance :: !Index !ClassInstance !u:InstanceSymbols !*TypeHeaps !*CheckState -> (!ClassInstance, !u:InstanceSymbols, !*TypeHeaps, !*CheckState) check_instance module_index - ins=:{ins_members,ins_class={glob_object = class_name =: {ds_ident = {id_name,id_info},ds_arity}},ins_type,ins_specials,ins_pos,ins_ident} + ins=:{ins_members,ins_class={glob_object = class_ident =: {ds_ident = {id_name,id_info},ds_arity}},ins_type,ins_specials,ins_pos,ins_ident} is=:{is_class_defs,is_modules} type_heaps cs=:{cs_symbol_table} # (entry, cs_symbol_table) = readPtr id_info cs_symbol_table # cs = pushErrorAdmin (newPosition ins_ident ins_pos) { cs & cs_symbol_table = cs_symbol_table } @@ -491,10 +491,10 @@ where check_class_instance :: ClassDef !Index !Index !Index !ClassInstance !u:InstanceSymbols !*TypeHeaps !*CheckState -> (!ClassInstance, !u:InstanceSymbols, !*TypeHeaps, !*CheckState) check_class_instance class_def module_index class_index class_mod_index - ins=:{ins_members,ins_class={glob_object = class_name =: {ds_ident = {id_name,id_info},ds_arity}},ins_type,ins_specials,ins_pos,ins_ident} + ins=:{ins_members,ins_class={glob_object = class_ident =: {ds_ident = {id_name,id_info},ds_arity}},ins_type,ins_specials,ins_pos,ins_ident} is=:{is_class_defs,is_modules} type_heaps cs=:{cs_symbol_table} | class_def.class_arity == ds_arity - # ins_class = { glob_object = { class_name & ds_index = class_index }, glob_module = class_mod_index} + # ins_class = { glob_object = { class_ident & ds_index = class_index }, glob_module = class_mod_index} (ins_type, ins_specials, is_type_defs, is_class_defs, is_modules, type_heaps, cs) = checkInstanceType module_index ins_class ins_type ins_specials is.is_type_defs is.is_class_defs is.is_modules type_heaps cs @@ -528,27 +528,27 @@ where = (instance_types, instance_defs, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) check_class_instance {ins_pos,ins_class,ins_members,ins_type} mod_index instance_types class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs - # ({class_members,class_name}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules + # ({class_members,class_ident}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules class_size = size class_members | class_size == size ins_members # (instance_types, member_defs, type_defs, modules, var_heap, type_heaps, cs) = check_member_instances mod_index ins_class.glob_module - 0 class_size ins_members class_members class_name ins_pos ins_type instance_types member_defs type_defs modules var_heap type_heaps cs + 0 class_size ins_members class_members class_ident ins_pos ins_type instance_types member_defs type_defs modules var_heap type_heaps cs = (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) // otherwise - # cs = { cs & cs_error = checkErrorWithIdentPos (newPosition class_name ins_pos) "different number of members specified" cs.cs_error } + # cs = { cs & cs_error = checkErrorWithIdentPos (newPosition class_ident ins_pos) "different number of members specified" cs.cs_error } = (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) /* check_generic_instance {ins_class, ins_members, ins_generate} mod_index instance_types class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs - # ({gen_name, gen_member_name}, generic_defs, modules) = getGenericDef ins_class mod_index generic_defs modules + # ({gen_ident, gen_member_ident}, generic_defs, modules) = getGenericDef ins_class mod_index generic_defs modules //| ins_generate // = (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) | size ins_members <> 1 - # cs = { cs & cs_error = checkError gen_name "generic instance must have one member" cs.cs_error } + # cs = { cs & cs_error = checkError gen_ident "generic instance must have one member" cs.cs_error } = (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) # member_name = ins_members.[0].ds_ident - | member_name <> gen_member_name + | member_name <> gen_member_ident # cs = { cs & cs_error = checkError member_name "wrong member name" cs.cs_error } = (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) // otherwise @@ -559,25 +559,25 @@ where -> (![(Index,SymbolType)], !v:{# MemberDef}, !blah:{# CheckedTypeDef}, !u:{# DclModule},!*VarHeap, !*TypeHeaps, !*CheckState) check_member_instances module_index member_mod_index mem_offset class_size ins_members class_members - class_name ins_pos ins_type instance_types member_defs type_defs modules var_heap type_heaps cs=:{cs_x={x_main_dcl_module_n}} + class_ident ins_pos ins_type instance_types member_defs type_defs modules var_heap type_heaps cs=:{cs_x={x_main_dcl_module_n}} | mem_offset == class_size = (instance_types, member_defs, type_defs, modules, var_heap, type_heaps, cs) # ins_member = ins_members.[mem_offset] class_member = class_members.[mem_offset] - cs = setErrorAdmin (newPosition class_name ins_pos) cs + cs = setErrorAdmin (newPosition class_ident ins_pos) cs | ins_member.ds_ident <> class_member.ds_ident - = check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members class_name ins_pos ins_type + = check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members class_ident ins_pos ins_type instance_types member_defs type_defs modules var_heap type_heaps { cs & cs_error = checkError class_member.ds_ident "instance of class member expected" cs.cs_error} | ins_member.ds_arity <> class_member.ds_arity - = check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members class_name ins_pos ins_type + = check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members class_ident ins_pos ins_type instance_types member_defs type_defs modules var_heap type_heaps { cs & cs_error = checkError class_member.ds_ident "used with wrong arity" cs.cs_error} - # ({me_symb, me_type,me_class_vars,me_pos}, member_defs, modules) = getMemberDef member_mod_index class_member.ds_index module_index member_defs modules + # ({me_ident, me_type,me_class_vars,me_pos}, member_defs, modules) = getMemberDef member_mod_index class_member.ds_index module_index member_defs modules (instance_type, _, type_heaps, Yes (modules, type_defs), cs_error) = determineTypeOfMemberInstance me_type me_class_vars ins_type SP_None type_heaps (Yes (modules, type_defs, x_main_dcl_module_n)) cs.cs_error (st_context, var_heap) = initializeContextVariables instance_type.st_context var_heap - = check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members class_name ins_pos ins_type + = check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members class_ident ins_pos ins_type [ (ins_member.ds_index, { instance_type & st_context = st_context }) : instance_types ] member_defs type_defs modules var_heap type_heaps { cs & cs_error = cs_error } @@ -749,25 +749,25 @@ where check_it _ _ state = state - must_not_be_essentially_unique x_main_dcl_module_n {tv_name, tv_info_ptr} th_vars modules type_defs error + must_not_be_essentially_unique x_main_dcl_module_n {tv_ident, tv_info_ptr} th_vars modules type_defs error # (TVI_Type type, th_vars) = readPtr tv_info_ptr th_vars = case type of - TA {type_name, type_index} _ - -> must_not_be_essentially_unique_for_TA type_name type_index th_vars - TAS {type_name, type_index} _ _ - -> must_not_be_essentially_unique_for_TA type_name type_index th_vars + TA {type_ident, type_index} _ + -> must_not_be_essentially_unique_for_TA type_ident type_index th_vars + TAS {type_ident, type_index} _ _ + -> must_not_be_essentially_unique_for_TA type_ident type_index th_vars _ -> (False, th_vars, modules, type_defs, error) where - must_not_be_essentially_unique_for_TA type_name type_index th_vars + must_not_be_essentially_unique_for_TA type_ident type_index th_vars # (type_def, type_defs, modules) = getTypeDef x_main_dcl_module_n type_index type_defs modules = case type_def.td_attribute of TA_Unique -> (True, th_vars, modules, type_defs, - checkError type_name + checkError type_ident ( "is unique but instanciates class variable " - +++tv_name.id_name + +++tv_ident.id_name +++" that is non uniquely used in a member type" ) error ) @@ -806,11 +806,11 @@ where class_defs member_defs modules instance_defs type_heaps var_heap predef_symbols error | inst_index < size instance_defs # (instance_def=:{ins_class,ins_pos,ins_type,ins_specials}, instance_defs) = instance_defs![inst_index] - # ({class_name, class_members}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules + # ({class_ident, class_members}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules class_size = size class_members (ins_members, memb_inst_defs1, member_defs, modules, type_heaps, var_heap, error) = determine_instance_symbols_and_types x_main_dcl_module_n next_mem_inst_index 0 mod_index ins_class.glob_module class_size class_members - ins_type ins_specials class_name ins_pos member_defs modules type_heaps var_heap error + ins_type ins_specials class_ident ins_pos member_defs modules type_heaps var_heap error instance_def = { instance_def & ins_members = { member \\ member <- ins_members }} (ins_specials, next_class_inst_index, all_class_specials, type_heaps, predef_symbols,error) = check_instance_specials mod_index instance_def inst_index ins_specials next_class_inst_index all_class_specials type_heaps predef_symbols error @@ -825,22 +825,22 @@ where !w:{#MemberDef} !u:{#DclModule} !*TypeHeaps !*VarHeap !*ErrorAdmin -> (![DefinedSymbol], ![FunType], !w:{#MemberDef}, !u:{#DclModule}, !*TypeHeaps, !*VarHeap, !.ErrorAdmin) determine_instance_symbols_and_types x_main_dcl_module_n first_inst_index mem_offset module_index member_mod_index class_size class_members - ins_type ins_specials class_name ins_pos member_defs modules type_heaps var_heap cs_error + ins_type ins_specials class_ident ins_pos member_defs modules type_heaps var_heap cs_error | mem_offset == class_size = ([], [], member_defs, modules, type_heaps, var_heap, cs_error) # class_member = class_members.[mem_offset] - ({me_symb,me_type,me_priority,me_class_vars}, member_defs, modules) = getMemberDef member_mod_index class_member.ds_index module_index member_defs modules + ({me_ident,me_type,me_priority,me_class_vars}, member_defs, modules) = getMemberDef member_mod_index class_member.ds_index module_index member_defs modules cs_error - = pushErrorAdmin (newPosition class_name ins_pos) cs_error + = pushErrorAdmin (newPosition class_ident ins_pos) cs_error (instance_type, new_ins_specials, type_heaps, Yes (modules, _), cs_error) = determineTypeOfMemberInstance me_type me_class_vars ins_type ins_specials type_heaps (Yes (modules, {}, cUndef)) cs_error cs_error = popErrorAdmin cs_error (new_info_ptr, var_heap) = newPtr VI_Empty var_heap - inst_def = MakeNewFunctionType me_symb me_type.st_arity me_priority instance_type ins_pos new_ins_specials new_info_ptr + inst_def = MakeNewFunctionType me_ident me_type.st_arity me_priority instance_type ins_pos new_ins_specials new_info_ptr (inst_symbols, memb_inst_defs, member_defs, modules, type_heaps, var_heap, cs_error) = determine_instance_symbols_and_types x_main_dcl_module_n first_inst_index (inc mem_offset) module_index member_mod_index - class_size class_members ins_type ins_specials class_name ins_pos member_defs modules type_heaps var_heap cs_error + class_size class_members ins_type ins_specials class_ident ins_pos member_defs modules type_heaps var_heap cs_error = ([{ class_member & ds_index = first_inst_index + mem_offset } : inst_symbols], [inst_def : memb_inst_defs], member_defs, modules, type_heaps, var_heap, cs_error) check_instance_specials :: !Index !ClassInstance !Index !Specials !Index ![ClassInstance] !*TypeHeaps !*PredefinedSymbols !*ErrorAdmin @@ -944,8 +944,8 @@ ident_for_errors_from_fun_symb_and_fun_kind {id_name} (FK_Function fun_name_is_l | fun_name_is_location_dependent && size id_name>0 # beautiful_name = if (id_name.[0]==backslash) "lambda" "comprehension" = { id_name=beautiful_name, id_info=nilPtr } -ident_for_errors_from_fun_symb_and_fun_kind fun_symb _ - = fun_symb +ident_for_errors_from_fun_symb_and_fun_kind fun_ident _ + = fun_ident // check that there are no strict lets, mark top-level cases as explicit class checkMacro a :: !Bool !a !*ErrorAdmin -> (!a, !*ErrorAdmin) @@ -1049,9 +1049,9 @@ checkFunctionBodyIfMacro _ def ea checkFunction :: !FunDef !Index !FunctionOrMacroIndex !Level !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!FunDef,!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState); -checkFunction fun_def=:{fun_symb,fun_pos,fun_body,fun_type,fun_kind} mod_index fun_index def_level local_functions_index_offset +checkFunction fun_def=:{fun_ident,fun_pos,fun_body,fun_type,fun_kind} mod_index fun_index def_level local_functions_index_offset fun_defs e_info=:{ef_type_defs,ef_modules,ef_class_defs,ef_is_macro_fun} heaps=:{hp_var_heap,hp_expression_heap,hp_type_heaps,hp_generic_heap} cs=:{cs_error} - # function_ident_for_errors = ident_for_errors_from_fun_symb_and_fun_kind fun_symb fun_kind + # function_ident_for_errors = ident_for_errors_from_fun_symb_and_fun_kind fun_ident fun_kind # cs = {cs & cs_error = pushErrorAdmin (newPosition function_ident_for_errors fun_pos) cs_error} (fun_type, ef_type_defs, ef_class_defs, ef_modules, hp_var_heap, hp_type_heaps, cs) @@ -1099,14 +1099,14 @@ where remove_calls_from_symbol_table fun_index fun_level [FunCall fc_index fc_level : fun_calls] fun_defs macro_defs symbol_table | fc_level <= fun_level - # (id_info, fun_defs) = fun_defs![fc_index].fun_symb.id_info + # (id_info, fun_defs) = fun_defs![fc_index].fun_ident.id_info # (entry, symbol_table) = readPtr id_info symbol_table # symbol_table = remove_call entry.ste_kind fun_index entry id_info symbol_table = remove_calls_from_symbol_table fun_index fun_level fun_calls fun_defs macro_defs symbol_table = remove_calls_from_symbol_table fun_index fun_level fun_calls fun_defs macro_defs symbol_table remove_calls_from_symbol_table fun_index fun_level [MacroCall module_index fc_index fc_level : fun_calls] fun_defs macro_defs symbol_table | fc_level <= fun_level - # (id_info, macro_defs) = macro_defs![module_index,fc_index].fun_symb.id_info + # (id_info, macro_defs) = macro_defs![module_index,fc_index].fun_ident.id_info # (entry, symbol_table) = readPtr id_info symbol_table # symbol_table = remove_call entry.ste_kind fun_index entry id_info symbol_table = remove_calls_from_symbol_table fun_index fun_level fun_calls fun_defs macro_defs symbol_table @@ -1196,7 +1196,7 @@ checkInstanceBodies icl_instances_ranges local_functions_index_offset fun_defs e instance < FunDef where - (<) fd1 fd2 = fd1.fun_symb.id_name < fd2.fun_symb.id_name + (<) fd1 fd2 = fd1.fun_ident.id_name < fd2.fun_ident.id_name createCommonDefinitions :: (CollectedDefinitions ClassInstance a) -> .CommonDefs; createCommonDefinitions {def_types,def_constructors,def_selectors,def_classes,def_members,def_instances, def_generics,def_generic_cases} @@ -1277,24 +1277,24 @@ collectCommonfinitions {def_types,def_constructors,def_selectors,def_classes,def sizes = { sizes & [cGenericCaseDefs] = size } = (sizes, defs) where - type_def_to_dcl {td_name, td_pos} (decl_index, decls) - = (inc decl_index, [Declaration { decl_ident = td_name, decl_pos = td_pos, decl_kind = STE_Type, decl_index = decl_index } : decls]) - cons_def_to_dcl {cons_symb, cons_pos} (decl_index, decls) - = (inc decl_index, [Declaration { decl_ident = cons_symb, decl_pos = cons_pos, decl_kind = STE_Constructor, decl_index = decl_index } : decls]) - selector_def_to_dcl {sd_symb, sd_field, sd_pos} (decl_index, decls) - = (inc decl_index, [Declaration { decl_ident = sd_field, decl_pos = sd_pos, decl_kind = STE_Field sd_symb, decl_index = decl_index } : decls]) - class_def_to_dcl {class_name, class_pos} (decl_index, decls) - = (inc decl_index, [Declaration { decl_ident = class_name, decl_pos = class_pos, decl_kind = STE_Class, decl_index = decl_index } : decls]) - member_def_to_dcl {me_symb, me_pos} (decl_index, decls) - = (inc decl_index, [Declaration { decl_ident = me_symb, decl_pos = me_pos, decl_kind = STE_Member, decl_index = decl_index } : decls]) + type_def_to_dcl {td_ident, td_pos} (decl_index, decls) + = (inc decl_index, [Declaration { decl_ident = td_ident, decl_pos = td_pos, decl_kind = STE_Type, decl_index = decl_index } : decls]) + cons_def_to_dcl {cons_ident, cons_pos} (decl_index, decls) + = (inc decl_index, [Declaration { decl_ident = cons_ident, decl_pos = cons_pos, decl_kind = STE_Constructor, decl_index = decl_index } : decls]) + selector_def_to_dcl {sd__ident, sd_field, sd_pos} (decl_index, decls) + = (inc decl_index, [Declaration { decl_ident = sd_field, decl_pos = sd_pos, decl_kind = STE_Field sd__ident, decl_index = decl_index } : decls]) + class_def_to_dcl {class_ident, class_pos} (decl_index, decls) + = (inc decl_index, [Declaration { decl_ident = class_ident, decl_pos = class_pos, decl_kind = STE_Class, decl_index = decl_index } : decls]) + member_def_to_dcl {me_ident, me_pos} (decl_index, decls) + = (inc decl_index, [Declaration { decl_ident = me_ident, decl_pos = me_pos, decl_kind = STE_Member, decl_index = decl_index } : decls]) instance_def_to_dcl {ins_class, ins_ident, ins_pos} (decl_index, decls) = (inc decl_index, [Declaration { decl_ident = ins_ident, decl_pos = ins_pos, decl_kind = STE_Instance ins_class.glob_object.ds_ident, decl_index = decl_index } : decls]) - generic_def_to_dcl {gen_name, gen_member_name, gen_type, gen_pos} (decl_index, decls) - # generic_decl = Declaration { decl_ident = gen_name, decl_pos = gen_pos, decl_kind = STE_Generic, decl_index = decl_index } - # member_decl = Declaration { decl_ident = gen_member_name, decl_pos = gen_pos, decl_kind = STE_Generic, decl_index = decl_index } + generic_def_to_dcl {gen_ident, gen_member_ident, gen_type, gen_pos} (decl_index, decls) + # generic_decl = Declaration { decl_ident = gen_ident, decl_pos = gen_pos, decl_kind = STE_Generic, decl_index = decl_index } + # member_decl = Declaration { decl_ident = gen_member_ident, decl_pos = gen_pos, decl_kind = STE_Generic, decl_index = decl_index } = (inc decl_index, [generic_decl, member_decl : decls]) - gen_case_def_to_dcl {gc_name, gc_pos} (decl_index, decls) - = (inc decl_index, [Declaration { decl_ident = gc_name, decl_pos = gc_pos, decl_kind = STE_GenericCase, decl_index = decl_index } : decls]) + gen_case_def_to_dcl {gc_ident, gc_pos} (decl_index, decls) + = (inc decl_index, [Declaration { decl_ident = gc_ident, decl_pos = gc_pos, decl_kind = STE_GenericCase, decl_index = decl_index } : decls]) collectMacros {ir_from,ir_to} macro_defs sizes_defs = collectGlobalFunctions cMacroDefs ir_from ir_to macro_defs sizes_defs @@ -1303,24 +1303,24 @@ collectFunctionTypes fun_types (sizes, defs) # (size, defs) = foldSt fun_type_to_dcl fun_types (0, defs) = ({ sizes & [cFunctionDefs] = size }, defs) where - fun_type_to_dcl {ft_symb, ft_pos} (decl_index, decls) - = (inc decl_index, [Declaration { decl_ident = ft_symb, decl_pos = ft_pos, decl_kind = STE_DclFunction, decl_index = decl_index } : decls]) + fun_type_to_dcl {ft_ident, ft_pos} (decl_index, decls) + = (inc decl_index, [Declaration { decl_ident = ft_ident, decl_pos = ft_pos, decl_kind = STE_DclFunction, decl_index = decl_index } : decls]) collectGlobalFunctions def_index from_index to_index fun_defs (sizes, defs) # (defs, fun_defs) = iFoldSt fun_def_to_decl from_index to_index (defs, fun_defs) = (fun_defs, ({ sizes & [def_index] = to_index - from_index }, defs)) where fun_def_to_decl decl_index (defs, fun_defs) - # ({fun_symb, fun_pos}, fun_defs) = fun_defs![decl_index] - = ([Declaration { decl_ident = fun_symb, decl_pos = fun_pos, decl_kind = STE_FunctionOrMacro [], decl_index = decl_index } : defs], fun_defs) + # ({fun_ident, fun_pos}, fun_defs) = fun_defs![decl_index] + = ([Declaration { decl_ident = fun_ident, decl_pos = fun_pos, decl_kind = STE_FunctionOrMacro [], decl_index = decl_index } : defs], fun_defs) collectDclMacros {ir_from=from_index,ir_to=to_index} fun_defs (sizes, defs) # (defs, fun_defs) = iFoldSt macro_def_to_dcl from_index to_index (defs, fun_defs) = (fun_defs, ({ sizes & [cMacroDefs] = to_index - from_index }, defs)) where macro_def_to_dcl decl_index (defs, fun_defs) - # ({fun_symb, fun_pos}, fun_defs) = fun_defs![decl_index] - = ([Declaration { decl_ident = fun_symb, decl_pos = fun_pos, decl_kind = STE_DclMacroOrLocalMacroFunction [], decl_index = decl_index } : defs], fun_defs) + # ({fun_ident, fun_pos}, fun_defs) = fun_defs![decl_index] + = ([Declaration { decl_ident = fun_ident, decl_pos = fun_pos, decl_kind = STE_DclMacroOrLocalMacroFunction [], decl_index = decl_index } : defs], fun_defs) gimme_a_lazy_array_type :: !u:{.a} -> v:{.a}, [u<=v] gimme_a_lazy_array_type a = a @@ -1465,12 +1465,12 @@ renumber_icl_definitions_as_dcl_definitions (Yes icl_to_dcl_index_table) icl_siz reorder_common_definitions {com_type_defs,com_cons_defs,com_selector_defs,com_class_defs,com_member_defs,com_instance_defs,com_generic_defs,com_gencase_defs} # dummy_ident = {id_name="",id_info=nilPtr} # com_type_defs=reorder_and_enlarge_array com_type_defs n_dictionary_types icl_to_dcl_index_table.[cTypeDefs] - {td_name=dummy_ident,td_index= -1,td_arity=0,td_args=[],td_attrs=[],td_context=[],td_rhs=UnknownType,td_attribute=TA_None,td_pos=NoPos,td_used_types=[]} + {td_ident=dummy_ident,td_index= -1,td_arity=0,td_args=[],td_attrs=[],td_context=[],td_rhs=UnknownType,td_attribute=TA_None,td_pos=NoPos,td_used_types=[]} # dummy_symbol_type={st_vars=[],st_args=[],st_args_strictness=NotStrict,st_arity=0,st_result={at_attribute=TA_None,at_type=TE},st_context=[],st_attr_vars=[],st_attr_env=[]} # com_selector_defs=reorder_and_enlarge_array com_selector_defs n_dictionary_selectors icl_to_dcl_index_table.[cSelectorDefs] - {sd_symb=dummy_ident,sd_field=dummy_ident,sd_type=dummy_symbol_type,sd_exi_vars=[],sd_field_nr=0,sd_type_index=0,sd_type_ptr=nilPtr,sd_pos=NoPos} + {sd__ident=dummy_ident,sd_field=dummy_ident,sd_type=dummy_symbol_type,sd_exi_vars=[],sd_field_nr=0,sd_type_index=0,sd_type_ptr=nilPtr,sd_pos=NoPos} # com_cons_defs=reorder_and_enlarge_array com_cons_defs n_dictionary_constructors icl_to_dcl_index_table.[cConstructorDefs] - {cons_symb=dummy_ident,cons_type=dummy_symbol_type,cons_arg_vars=[],cons_priority=NoPrio,cons_index= -1,cons_type_index= -1,cons_exi_vars=[],cons_type_ptr=nilPtr,cons_pos=NoPos} + {cons_ident=dummy_ident,cons_type=dummy_symbol_type,cons_arg_vars=[],cons_priority=NoPrio,cons_index= -1,cons_type_index= -1,cons_exi_vars=[],cons_type_ptr=nilPtr,cons_pos=NoPos} # com_class_defs=reorder_array com_class_defs icl_to_dcl_index_table.[cClassDefs] # com_member_defs=reorder_array com_member_defs icl_to_dcl_index_table.[cMemberDefs] # com_instance_defs=reorder_array com_instance_defs icl_to_dcl_index_table.[cInstanceDefs] @@ -1614,13 +1614,13 @@ where # new_cons_defs = if (dcl_cons_index==(-1)) new_cons_defs [ com_cons_defs.[dcl_cons_index] : new_cons_defs ] # (rt_fields, cs) = redirect_field_symbols td_pos rt_fields cs = ([ { td & td_rhs = RecordType { rt & rt_constructor = rt_constructor, rt_fields = rt_fields }} : new_type_defs ],new_cons_defs,new_selector_defs,conversion_table,icl_sizes,icl_decl_symbols,cs) - add_type_def td=:{td_name, td_pos, td_rhs = AbstractType _} new_type_defs new_cons_defs new_selector_defs conversion_table icl_sizes icl_decl_symbols cs + add_type_def td=:{td_ident, td_pos, td_rhs = AbstractType _} new_type_defs new_cons_defs new_selector_defs conversion_table icl_sizes icl_decl_symbols cs # cs_error = checkError "abstract type not defined in implementation module" "" - (setErrorAdmin (newPosition td_name td_pos) cs.cs_error) + (setErrorAdmin (newPosition td_ident td_pos) cs.cs_error) = (new_type_defs,new_cons_defs,new_selector_defs,conversion_table,icl_sizes,icl_decl_symbols,{ cs & cs_error = cs_error }) - add_type_def td=:{td_name, td_pos, td_rhs = AbstractSynType _ _} new_type_defs new_cons_defs new_selector_defs conversion_table icl_sizes icl_decl_symbols cs + add_type_def td=:{td_ident, td_pos, td_rhs = AbstractSynType _ _} new_type_defs new_cons_defs new_selector_defs conversion_table icl_sizes icl_decl_symbols cs # cs_error = checkError "abstract type not defined in implementation module" "" - (setErrorAdmin (newPosition td_name td_pos) cs.cs_error) + (setErrorAdmin (newPosition td_ident td_pos) cs.cs_error) = (new_type_defs,new_cons_defs,new_selector_defs,conversion_table,icl_sizes,icl_decl_symbols,{ cs & cs_error = cs_error }) add_type_def td new_type_defs new_cons_defs new_selector_defs conversion_table icl_sizes icl_decl_symbols cs = ([td : new_type_defs],new_cons_defs,new_selector_defs,conversion_table,icl_sizes,icl_decl_symbols,cs) @@ -1631,10 +1631,10 @@ where where redirect_field_symbol pos fields field_nr (new_fields, cs) # field = fields.[field_nr] - ({ste_kind,ste_index}, cs_symbol_table) = readPtr field.fs_name.id_info cs.cs_symbol_table + ({ste_kind,ste_index}, cs_symbol_table) = readPtr field.fs_ident.id_info cs.cs_symbol_table | is_field ste_kind = ({ new_fields & [field_nr] = { field & fs_index = ste_index }}, { cs & cs_symbol_table = cs_symbol_table }) - # cs_error = checkError "conflicting definition in implementation module" "" (setErrorAdmin (newPosition field.fs_name pos) cs.cs_error) + # cs_error = checkError "conflicting definition in implementation module" "" (setErrorAdmin (newPosition field.fs_ident pos) cs.cs_error) = (new_fields, { cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table }) is_field (STE_Field _) = True @@ -2089,9 +2089,9 @@ checkDclModuleWithinComponent dcl_imported_module_numbers component_nr is_on_cyc (mod_entry, cs_symbol_table) = readPtr dcl_name.id_info cs_symbol_table ({ ste_kind = STE_Module mod, ste_index }) = mod_entry cs = { cs & cs_symbol_table = writePtr dcl_name.id_info { mod_entry & ste_kind = STE_ClosedModule } cs_symbol_table} - # {mod_name,mod_defs={def_macro_indices,def_funtypes}} = mod + # {mod_ident,mod_defs={def_macro_indices,def_funtypes}} = mod = checkDclModule2 dcl_imported_module_numbers super_components.[mod_index] imports_ikh component_nr is_on_cycle modules_in_component_set - mod_name dcl_common def_macro_indices def_funtypes ste_index expl_imp_infos dcl_modules icl_functions macro_defs heaps cs + mod_ident dcl_common def_macro_indices def_funtypes ste_index expl_imp_infos dcl_modules icl_functions macro_defs heaps cs renumber_icl_module :: ModuleKind IndexRange IndexRange IndexRange Index Int {#Int} (Optional {#{#Int}}) IndexRange *{#FunDef} *CommonDefs [Declaration] *{#DclModule} *ErrorAdmin -> (![IndexRange],![IndexRange], ![IndexRange], !Int,!Index,!IndexRange,!*{#FunDef},!*CommonDefs,![Declaration],!*{#DclModule}, *ErrorAdmin); @@ -2179,7 +2179,7 @@ renumber_icl_module mod_type icl_global_function_range icl_instance_range icl_ge # n_specials = ir_to-ir_from | n_specials==0 = icl_functions - # dummy_function = {fun_symb={id_name="",id_info=nilPtr},fun_arity= -1,fun_priority=NoPrio,fun_body=NoBody,fun_type=No,fun_pos=NoPos,fun_kind=FK_Unknown,fun_lifted=0,fun_info=EmptyFunInfo} + # dummy_function = {fun_ident={id_name="",id_info=nilPtr},fun_arity= -1,fun_priority=NoPrio,fun_body=NoBody,fun_type=No,fun_pos=NoPos,fun_kind=FK_Unknown,fun_lifted=0,fun_info=EmptyFunInfo} = arrayPlusList icl_functions [dummy_function \\ i<-[0..n_specials-1]] add_dcl_instances_to_conversion_table :: (Optional {#{#Int}}) !Index !DclModule !*{# ClassInstance} !*{# GenericCaseDef} *ErrorAdmin @@ -2256,13 +2256,13 @@ checkModule m icl_global_function_range fun_defs n_functions_and_macros_in_dcl_m 0 # (predef_mod,predef_symbols) = buildPredefinedModule predef_symbols -> (Yes predef_mod,predef_symbols) _ -> (No,predef_symbols) - # (mod_name,mod_imported_objects,mod_imports,mod_type,icl_global_function_range,nr_of_functions,first_inst_index,first_gen_inst_index, local_defs,icl_functions,macro_defs,init_dcl_modules,main_dcl_module_n,cdefs,sizes,cs) + # (mod_ident,mod_imported_objects,mod_imports,mod_type,icl_global_function_range,nr_of_functions,first_inst_index,first_gen_inst_index, local_defs,icl_functions,macro_defs,init_dcl_modules,main_dcl_module_n,cdefs,sizes,cs) = check_module1 m icl_global_function_range fun_defs optional_dcl_mod optional_pre_def_mod scanned_modules dcl_modules cached_dcl_macros dcl_module_n_in_cache predef_symbols symbol_table err_file # icl_instance_range = {ir_from = first_inst_index, ir_to = first_gen_inst_index/*AA nr_of_functions*/} # icl_generic_range = {ir_from = first_gen_inst_index, ir_to = nr_of_functions} //AA - = check_module2 mod_name m.mod_modification_time mod_imported_objects mod_imports mod_type icl_global_function_range icl_instance_range icl_generic_range nr_of_functions nr_of_cached_modules optional_pre_def_mod local_defs icl_functions macro_defs init_dcl_modules cdefs sizes heaps cs + = check_module2 mod_ident m.mod_modification_time mod_imported_objects mod_imports mod_type icl_global_function_range icl_instance_range icl_generic_range nr_of_functions nr_of_cached_modules optional_pre_def_mod local_defs icl_functions macro_defs init_dcl_modules cdefs sizes heaps cs -check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs} icl_global_function_range fun_defs optional_dcl_mod optional_pre_def_mod scanned_modules dcl_modules cached_dcl_macros dcl_module_n_in_cache predef_symbols symbol_table err_file +check_module1 {mod_type,mod_ident,mod_imports,mod_imported_objects,mod_defs = cdefs} icl_global_function_range fun_defs optional_dcl_mod optional_pre_def_mod scanned_modules dcl_modules cached_dcl_macros dcl_module_n_in_cache predef_symbols symbol_table err_file # error = {ea_file = err_file, ea_loc = [], ea_ok = True } first_inst_index = length fun_defs @@ -2302,7 +2302,7 @@ check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cde dcl_modules.[i] init_new_dcl_modules.[i-size dcl_modules] \\ i<-[0..size dcl_modules+size init_new_dcl_modules-1]} - = (mod_name,mod_imported_objects,mod_imports,mod_type,icl_global_function_range,nr_of_functions,first_inst_index,first_gen_inst_index,local_defs,icl_functions,macro_defs,init_dcl_modules,main_dcl_module_n,cdefs,sizes,cs) + = (mod_ident,mod_imported_objects,mod_imports,mod_type,icl_global_function_range,nr_of_functions,first_inst_index,first_gen_inst_index,local_defs,icl_functions,macro_defs,init_dcl_modules,main_dcl_module_n,cdefs,sizes,cs) where add_dcl_module_predef_module_and_modules_to_symbol_table (Yes dcl_mod) optional_predef_mod modules mod_index cs @@ -2356,7 +2356,7 @@ check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cde (dcl_macro_defs, (sizes, defs)) = collectDclMacros mod_defs.def_macro_indices dcl_macro_defs sizes_and_defs mod = { mod & mod_defs = mod_defs } - (cs_symbol_table, cs_error) = addDefToSymbolTable cGlobalScope mod_index mod.mod_name (STE_Module mod) cs_symbol_table cs_error + (cs_symbol_table, cs_error) = addDefToSymbolTable cGlobalScope mod_index mod.mod_ident (STE_Module mod) cs_symbol_table cs_error = ((mod,sizes,defs),dcl_macro_defs,{ cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error }) where convert_class_instances :: ![ParsedInstance a] -> [ClassInstance] @@ -2380,15 +2380,15 @@ check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cde = ([], []) convert_generic_instances :: !.[GenericCaseDef] !Int -> (!.[FunDef], !.[GenericCaseDef]) - convert_generic_instances [gc=:{gc_name, gc_body=GCB_FunDef fun_def} : gcs] next_fun_index + convert_generic_instances [gc=:{gc_ident, gc_body=GCB_FunDef fun_def} : gcs] next_fun_index # (fun_defs, gcs) = convert_generic_instances gcs (inc next_fun_index) # gc = { gc & gc_body = GCB_FunIndex next_fun_index } = ([fun_def : fun_defs], [gc:gcs]) - //---> ("convert generic case: user defined function", gc.gc_name, gc.gc_type_cons, next_fun_index) - convert_generic_instances [gc=:{gc_name,gc_pos, gc_type_cons, gc_body=GCB_None} : gcs] next_fun_index + //---> ("convert generic case: user defined function", gc.gc_ident, gc.gc_type_cons, next_fun_index) + convert_generic_instances [gc=:{gc_ident,gc_pos, gc_type_cons, gc_body=GCB_None} : gcs] next_fun_index # (fun_defs, gcs) = convert_generic_instances gcs (inc next_fun_index) # fun_def = - { fun_symb = genericIdentToFunIdent gc_name gc_type_cons + { fun_ident = genericIdentToFunIdent gc_ident gc_type_cons , fun_arity = 0 , fun_priority = NoPrio , fun_body = GeneratedBody @@ -2400,13 +2400,13 @@ check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cde } # gc = { gc & gc_body = GCB_FunIndex next_fun_index } = ([fun_def:fun_defs], [gc:gcs]) - //---> ("convert generic case: function to derive ", gc.gc_name, gc.gc_type_cons, next_fun_index) + //---> ("convert generic case: function to derive ", gc.gc_ident, gc.gc_type_cons, next_fun_index) convert_generic_instances [] next_fun_index = ([], []) - determine_indexes_of_members [{fun_symb,fun_arity}:members] next_fun_index + determine_indexes_of_members [{fun_ident,fun_arity}:members] next_fun_index #! (member_symbols, last_fun_index) = determine_indexes_of_members members (inc next_fun_index) - = ([{ds_ident = fun_symb, ds_index = next_fun_index, ds_arity = fun_arity} : member_symbols], last_fun_index) + = ([{ds_ident = fun_ident, ds_index = next_fun_index, ds_arity = fun_arity} : member_symbols], last_fun_index) determine_indexes_of_members [] next_fun_index = ([], next_fun_index) @@ -2435,7 +2435,7 @@ check_module2 :: Ident {#Char} [.ImportedObject] .[Import ImportDeclaration] .Mo (Optional (Module a)) [Declaration] *{#FunDef} *{#*{#FunDef}} *{#DclModule} (CollectedDefinitions ClassInstance IndexRange) *{#.Int} *Heaps *CheckState -> (!Bool,.IclModule,!.{#DclModule},.{!Group},!*{#*{#FunDef}},!Int,!.Heaps,!.{#PredefinedSymbol},!.Heap SymbolTableEntry,!.File,[String]); -check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mod_type icl_global_function_range icl_instance_range icl_generic_range nr_of_functions nr_of_cached_modules optional_pre_def_mod local_defs icl_functions macro_defs init_dcl_modules cdefs sizes heaps cs +check_module2 mod_ident mod_modification_time mod_imported_objects mod_imports mod_type icl_global_function_range icl_instance_range icl_generic_range nr_of_functions nr_of_cached_modules optional_pre_def_mod local_defs icl_functions macro_defs init_dcl_modules cdefs sizes heaps cs # (main_dcl_module_n,cs)=cs!cs_x.x_main_dcl_module_n (copied_dcl_defs, dcl_conversions, dcl_modules, local_defs, cdefs, icl_sizes, cs) @@ -2518,7 +2518,7 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo # (icl_functions, e_info, heaps, cs) = checkAndPartitionateIclMacros main_dcl_module_n def_macro_indices local_functions_index_offset icl_functions e_info heaps cs (icl_functions, e_info, heaps, cs) = checkGlobalFunctionsInRanges icl_global_functions_ranges main_dcl_module_n local_functions_index_offset icl_functions e_info heaps cs - cs = check_start_rule mod_type mod_name icl_global_functions_ranges cs + cs = check_start_rule mod_type mod_ident icl_global_functions_ranges cs (icl_functions, e_info, heaps, cs) = checkGlobalFunctionsInRanges icl_generic_ranges main_dcl_module_n local_functions_index_offset icl_functions e_info heaps cs @@ -2526,7 +2526,7 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo (icl_functions, e_info, heaps, cs) = checkInstanceBodies icl_instances_ranges local_functions_index_offset icl_functions e_info heaps cs - cs = check_needed_modules_are_imported mod_name ".icl" cs + cs = check_needed_modules_are_imported mod_ident ".icl" cs {cs_symbol_table, cs_predef_symbols, cs_error,cs_x } = cs (icl_functions, hp_type_heaps, cs_error) @@ -2557,7 +2557,7 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo icl_common = { icl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs, com_cons_defs = e_info.ef_cons_defs, com_member_defs = e_info.ef_member_defs, com_generic_defs = e_info.ef_generic_defs, com_instance_defs = class_instances } - icl_mod = { icl_name = mod_name, icl_functions = icl_functions, icl_common = icl_common, + icl_mod = { icl_name = mod_ident, icl_functions = icl_functions, icl_common = icl_common, icl_global_functions = icl_global_functions_ranges, icl_instances = icl_instances_ranges, icl_specials = icl_specials, icl_gencases = icl_generic_ranges, icl_imported_objects = mod_imported_objects, icl_used_module_numbers = imported_module_numbers, icl_copied_from_dcl = copied_dcl_defs, @@ -2580,7 +2580,7 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo = (cs_error.ea_ok, icl_mod, dcl_modules, groups, macro_defs, cs_x.x_main_dcl_module_n, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file, directly_imported_dcl_modules) # icl_common = { icl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs, com_cons_defs = e_info.ef_cons_defs, com_member_defs = e_info.ef_member_defs, com_generic_defs = e_info.ef_generic_defs } - icl_mod = { icl_name = mod_name, icl_functions = icl_functions, icl_common = icl_common, + icl_mod = { icl_name = mod_ident, icl_functions = icl_functions, icl_common = icl_common, icl_global_functions = icl_global_functions_ranges, icl_instances = icl_instances_ranges, icl_specials = {ir_from = nr_of_functions, ir_to = nr_of_functions}, icl_gencases = icl_generic_ranges, @@ -2588,7 +2588,7 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo icl_import = icl_imported ,icl_modification_time = mod_modification_time} = (False, icl_mod, dcl_modules, {}, {}, cs_x.x_main_dcl_module_n,heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file, directly_imported_dcl_modules) where - check_start_rule mod_kind mod_name icl_global_functions_ranges cs=:{cs_symbol_table,cs_x} + check_start_rule mod_kind mod_ident icl_global_functions_ranges cs=:{cs_symbol_table,cs_x} # ({ste_kind, ste_index}, cs_symbol_table) = readPtr predefined_idents.[PD_Start].id_info cs_symbol_table cs = { cs & cs_symbol_table = cs_symbol_table } = case ste_kind of @@ -2605,12 +2605,12 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo _ -> case mod_kind of MK_Main - # pos = newPosition predefined_idents.[PD_Start] (LinePos (mod_name.id_name+++".icl") 1) + # pos = newPosition predefined_idents.[PD_Start] (LinePos (mod_ident.id_name+++".icl") 1) -> { cs & cs_error = checkErrorWithIdentPos pos " has not been declared" cs.cs_error } _ -> cs - check_predefined_module (Yes {mod_name={id_info}}) modules macro_and_fun_defs macro_defs heaps cs=:{cs_symbol_table} + check_predefined_module (Yes {mod_ident={id_info}}) modules macro_and_fun_defs macro_defs heaps cs=:{cs_symbol_table} # (entry, cs_symbol_table) = readPtr id_info cs_symbol_table # cs = { cs & cs_symbol_table = cs_symbol_table <:= (id_info, { entry & ste_kind = STE_ClosedModule })} {ste_kind = STE_Module mod, ste_index} = entry @@ -2650,12 +2650,12 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo = (icl_functions, heaps) = (icl_functions, heaps) - build_function new_fun_index fun_def=:{fun_symb, fun_body = CheckedBody {cb_args}, fun_info} fun_index fun_type + build_function new_fun_index fun_def=:{fun_ident, fun_body = CheckedBody {cb_args}, fun_info} fun_index fun_type (var_heap, type_var_heap, expr_heap) # (tb_args, var_heap) = mapSt new_free_var cb_args var_heap (app_args, expr_heap) = mapSt new_bound_var tb_args expr_heap (app_info_ptr, expr_heap) = newPtr EI_Empty expr_heap - tb_rhs = App { app_symb = { symb_name = fun_symb, + tb_rhs = App { app_symb = { symb_ident = fun_ident, symb_kind = SK_Function { glob_module = main_dcl_module_n, glob_object = fun_index }}, app_args = app_args, app_info_ptr = app_info_ptr } @@ -2664,9 +2664,9 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo (var_heap, type_var_heap, expr_heap)) new_bound_var :: !FreeVar !*ExpressionHeap -> (!Expression, !*ExpressionHeap) - new_bound_var {fv_name,fv_info_ptr} expr_heap + new_bound_var {fv_ident,fv_info_ptr} expr_heap # (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap - = (Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, expr_heap) + = (Var { var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, expr_heap) new_free_var :: !FreeVar *VarHeap -> (!FreeVar, !*VarHeap) new_free_var fv var_heap @@ -2711,7 +2711,7 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo = { instance_defs & [ds_index] = { inst_def & fun_type = Yes (makeElemTypeOfArrayFunctionStrict symbol_type ins_offset offset_table) } } checkSpecifiedInstanceType (index_of_member_fun, derived_symbol_type) (icl_functions, type_heaps, cs_error) - # ({fun_type, fun_pos, fun_symb}, icl_functions) = icl_functions![index_of_member_fun] + # ({fun_type, fun_pos, fun_ident}, icl_functions) = icl_functions![index_of_member_fun] # (cs_error, type_heaps) = case fun_type of No @@ -2721,7 +2721,7 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo = symbolTypesCorrespond specified_symbol_type derived_symbol_type type_heaps | err_code==CEC_Ok -> (cs_error, type_heaps) - # cs_error = pushErrorAdmin (newPosition fun_symb fun_pos) cs_error + # cs_error = pushErrorAdmin (newPosition fun_ident fun_pos) cs_error luxurious_explanation = case err_code of CEC_ResultNotOK -> "result type" @@ -2736,25 +2736,25 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo -> ( popErrorAdmin cs_error, type_heaps) = (icl_functions, type_heaps, cs_error) -check_needed_modules_are_imported mod_name extension cs=:{cs_x={x_needed_modules}} +check_needed_modules_are_imported mod_ident extension cs=:{cs_x={x_needed_modules}} # cs = case x_needed_modules bitand cNeedStdGeneric of 0 -> cs - _ -> check_it PD_StdGeneric mod_name "" extension cs + _ -> check_it PD_StdGeneric mod_ident "" extension cs # cs = case x_needed_modules bitand cNeedStdDynamic of 0 -> cs - _ -> switch_dynamics (check_it PD_StdDynamic mod_name "" extension cs) (switched_off_Clean_feature PD_StdDynamic mod_name " (dynamics are disabled)" extension cs) + _ -> switch_dynamics (check_it PD_StdDynamic mod_ident "" extension cs) (switched_off_Clean_feature PD_StdDynamic mod_ident " (dynamics are disabled)" extension cs) # cs = case x_needed_modules bitand cNeedStdArray of 0 -> cs - _ -> check_it PD_StdArray mod_name " (needed for array denotations)" extension cs + _ -> check_it PD_StdArray mod_ident " (needed for array denotations)" extension cs # cs = case x_needed_modules bitand cNeedStdEnum of 0 -> cs - _ -> check_it PD_StdEnum mod_name " (needed for [..] expressions)" extension cs + _ -> check_it PD_StdEnum mod_ident " (needed for [..] expressions)" extension cs # cs = case x_needed_modules bitand cNeedStdStrictLists of 0 -> cs - _ -> check_it PD_StdStrictLists mod_name " (needed for strict lists)" extension cs + _ -> check_it PD_StdStrictLists mod_ident " (needed for strict lists)" extension cs = cs where - check_it pd mod_name explanation extension cs=:{cs_symbol_table} + check_it pd mod_ident explanation extension cs=:{cs_symbol_table} # pds_ident = predefined_idents.[pd] # ({ste_kind}, cs_symbol_table) = readPtr pds_ident.id_info cs_symbol_table cs = { cs & cs_symbol_table = cs_symbol_table } @@ -2762,16 +2762,16 @@ check_needed_modules_are_imported mod_name extension cs=:{cs_x={x_needed_modules STE_ClosedModule -> cs _ - # error_location = { ip_ident = mod_name, ip_line = 1, ip_file = mod_name.id_name+++extension} + # error_location = { ip_ident = mod_ident, ip_line = 1, ip_file = mod_ident.id_name+++extension} cs_error = pushErrorAdmin error_location cs.cs_error cs_error = checkError pds_ident ("not imported"+++explanation) cs_error cs_error = popErrorAdmin cs_error -> { cs & cs_error = cs_error } // MV ... - switched_off_Clean_feature pd mod_name explanation extension cs=:{cs_symbol_table} + switched_off_Clean_feature pd mod_ident explanation extension cs=:{cs_symbol_table} # ident = predefined_idents.[pd] - # error_location = { ip_ident = mod_name, ip_line = 1, ip_file = mod_name.id_name+++extension} + # error_location = { ip_ident = mod_ident, ip_line = 1, ip_file = mod_ident.id_name+++extension} cs_error = pushErrorAdmin error_location cs.cs_error cs_error = checkError ident ("not supported"+++explanation) cs_error cs_error = popErrorAdmin cs_error @@ -2822,9 +2822,9 @@ makeElemTypeOfArrayFunctionStrict st=:{st_args,st_args_strictness,st_result} me_ st_result = { st_result & at_type = TAS tuple elems (add_strictness 0 strictness)}} = st -initialDclModule ({mod_name, mod_modification_time, mod_defs=mod_defs=:{def_funtypes,def_macro_indices}, mod_type}, sizes, all_defs) module_n +initialDclModule ({mod_ident, mod_modification_time, mod_defs=mod_defs=:{def_funtypes,def_macro_indices}, mod_type}, sizes, all_defs) module_n # dcl_common= createCommonDefinitions mod_defs - = { dcl_name = mod_name + = { dcl_name = mod_ident , dcl_functions = { function \\ function <- mod_defs.def_funtypes } , dcl_macros = def_macro_indices , dcl_instances = { ir_from = 0, ir_to = 0} @@ -2941,11 +2941,11 @@ addImportedSymbolsToSymbolTable importing_mod opt_macro_range modules_in_compone = ([], dcl_modules, cs) add_field importing_mod mod_index {fs_index} (declarations_accu, dcl_modules, cs) - # (sd=:{sd_symb, sd_field, sd_pos}, dcl_modules) + # (sd=:{sd__ident, sd_field, sd_pos}, dcl_modules) = dcl_modules![mod_index].dcl_common.com_selector_defs.[fs_index] declaration = Declaration { decl_ident = sd_field, decl_pos = sd_pos, - decl_kind = STE_Imported (STE_Field sd_symb) mod_index, decl_index = fs_index } + decl_kind = STE_Imported (STE_Field sd__ident) mod_index, decl_index = fs_index } (is_new, cs) = add_declaration_to_symbol_table No declaration importing_mod cs | is_new @@ -2953,10 +2953,10 @@ addImportedSymbolsToSymbolTable importing_mod opt_macro_range modules_in_compone = (declarations_accu, dcl_modules, cs) add_member importing_mod mod_index {ds_ident, ds_index} (declarations_accu, dcl_modules, cs) - # (sd=:{me_symb, me_pos}, dcl_modules) + # (sd=:{me_ident, me_pos}, dcl_modules) = dcl_modules![mod_index].dcl_common.com_member_defs.[ds_index] declaration - = Declaration { decl_ident = me_symb, decl_pos = me_pos, + = Declaration { decl_ident = me_ident, decl_pos = me_pos, decl_kind = STE_Imported STE_Member mod_index, decl_index = ds_index } (is_new, cs) = add_declaration_to_symbol_table No declaration importing_mod cs @@ -3094,7 +3094,7 @@ foldlBelongingSymbols f bs st BS_Constructors constructors -> foldSt (\{ds_ident} st -> f ds_ident st) constructors st BS_Fields fields - -> foldlArraySt (\{fs_name} st -> f fs_name st) fields st + -> foldlArraySt (\{fs_ident} st -> f fs_ident st) fields st BS_Members members -> foldlArraySt (\{ds_ident} st -> f ds_ident st) members st BS_Nothing @@ -3265,11 +3265,11 @@ checkInstancesOfDclModule mod_index (nr_of_dcl_functions_and_instances, nr_of_dc = create_funs (inc gc_index) (inc fun_index) gencase_defs hp_var_heap = (fun_index, [fun:funs], gencase_defs, hp_var_heap) create_fun gc_index fun_index gencase_defs hp_var_heap - # (gencase_def=:{gc_name, gc_pos, gc_type_cons}, gencase_defs) = gencase_defs ! [gc_index] + # (gencase_def=:{gc_ident, gc_pos, gc_type_cons}, gencase_defs) = gencase_defs ! [gc_index] # gencase_def = { gencase_def & gc_body = GCB_FunIndex fun_index } # gencase_defs = {gencase_defs & [gc_index] = gencase_def} - #! fun_ident = genericIdentToFunIdent gc_name gc_type_cons + #! fun_ident = genericIdentToFunIdent gc_ident gc_type_cons #! dummy_ds = { ds_ident = fun_ident , ds_arity = 0 @@ -3277,7 +3277,7 @@ checkInstancesOfDclModule mod_index (nr_of_dcl_functions_and_instances, nr_of_dc } #! (var_info_ptr, hp_var_heap) = newPtr VI_Empty hp_var_heap #! fun = - { ft_symb = fun_ident + { ft_ident = fun_ident , ft_arity = 0 , ft_priority = NoPrio , ft_type = {st_vars=[],st_attr_vars=[],st_arity=0,st_args=[],st_result={at_type=TE,at_attribute=TA_Multi},st_attr_env=[],st_context=[],st_args_strictness=NotStrict} @@ -3287,7 +3287,7 @@ checkInstancesOfDclModule mod_index (nr_of_dcl_functions_and_instances, nr_of_dc } = (fun, gencase_defs, hp_var_heap) - //---> ("create_gencase_funtypes", gc_name, gc_type_cons, gc_index, fun_index) + //---> ("create_gencase_funtypes", gc_ident, gc_type_cons, gc_index, fun_index) adjust_instance_types_of_array_functions_in_std_array_dcl array_mod_index class_members class_instances fun_types cs=:{cs_predef_symbols} #! nr_of_instances = size class_instances @@ -3318,8 +3318,8 @@ checkDclModule :: !NumberSet ![Int] !(IntKeyHashtable SolvedImports) !Int !Bool !(Module (CollectedDefinitions ClassInstance IndexRange)) !Index !*ExplImpInfos !*{#DclModule} !*{#FunDef} !*{#*{#FunDef}} !*Heaps !*CheckState -> (!(!Int,!Index,![FunType]), !(!*ExplImpInfos, !*{#DclModule}, !*{#FunDef},!*{#*{#FunDef}},!*Heaps, !*CheckState)) checkDclModule dcl_imported_module_numbers super_components imports_ikh component_nr is_on_cycle modules_in_component_set - mod=:{mod_name,mod_defs=mod_defs=:{def_macro_indices,def_funtypes}} mod_index expl_imp_info modules icl_functions macro_defs heaps cs -// | False--->("checkDclModule", mod_name, mod_index) //, modules.[mod_index].dcl_declared.dcls_local) + mod=:{mod_ident,mod_defs=mod_defs=:{def_macro_indices,def_funtypes}} mod_index expl_imp_info modules icl_functions macro_defs heaps cs +// | False--->("checkDclModule", mod_ident, mod_index) //, modules.[mod_index].dcl_declared.dcls_local) // = undef # dcl_common = createCommonDefinitions mod_defs #! first_type_index = size dcl_common.com_type_defs @@ -3331,13 +3331,13 @@ checkDclModule dcl_imported_module_numbers super_components imports_ikh componen = number_class_dictionaries (inc class_index) class_defs (inc index_type) = class_defs = checkDclModule2 dcl_imported_module_numbers super_components imports_ikh component_nr is_on_cycle modules_in_component_set - mod_name dcl_common def_macro_indices def_funtypes mod_index expl_imp_info modules icl_functions macro_defs heaps cs + mod_ident dcl_common def_macro_indices def_funtypes mod_index expl_imp_info modules icl_functions macro_defs heaps cs checkDclModule2 :: !NumberSet ![Int] !(IntKeyHashtable SolvedImports) !Int !Bool !LargeBitvect !Ident *CommonDefs !IndexRange ![FunType] !Index !*ExplImpInfos !*{#DclModule} !*{#FunDef} !*{#*{#FunDef}} !*Heaps !*CheckState -> (!(!Int,!Index,![FunType]), !(!*ExplImpInfos, !*{#DclModule}, !*{#FunDef},!*{#*{#FunDef}},!*Heaps, !*CheckState)) checkDclModule2 dcl_imported_module_numbers super_components imports_ikh component_nr is_on_cycle modules_in_component_set - mod_name dcl_common dcl_macros dcl_funtypes mod_index expl_imp_info modules icl_functions macro_defs heaps cs + mod_ident dcl_common dcl_macros dcl_funtypes mod_index expl_imp_info modules icl_functions macro_defs heaps cs # (dcl_mod, modules) = modules![mod_index] dcl_defined = dcl_mod.dcl_declared.dcls_local cs = addGlobalDefinitionsToSymbolTable dcl_defined cs @@ -3371,7 +3371,7 @@ checkDclModule2 dcl_imported_module_numbers super_components imports_ikh compone (icl_functions, e_info=:{ef_modules=modules,ef_macro_defs=macro_defs}, heaps=:{hp_expression_heap}, cs) = checkAndPartitionateDclMacros mod_index dcl_macros icl_functions e_info heaps cs - cs = check_needed_modules_are_imported mod_name ".dcl" cs + cs = check_needed_modules_are_imported mod_ident ".dcl" cs com_instance_defs = dcl_common.com_instance_defs diff --git a/frontend/checkFunctionBodies.icl b/frontend/checkFunctionBodies.icl index 6f1b702..dca1378 100644 --- a/frontend/checkFunctionBodies.icl +++ b/frontend/checkFunctionBodies.icl @@ -74,7 +74,7 @@ make_unboxed_list type_symbol expr_heap cs # (stdStrictLists_index,cons_u_index,decons_u_index,nil_u_index,decons_u_ident,cs) = get_unboxed_list_indices_and_decons_u_ident cs # unboxed_list=UnboxedList type_symbol stdStrictLists_index decons_u_index nil_u_index # (new_info_ptr,expr_heap) = newPtr EI_Empty expr_heap - # decons_expr = App {app_symb={symb_name=decons_u_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_u_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr} + # decons_expr = App {app_symb={symb_ident=decons_u_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_u_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr} = (unboxed_list,decons_expr,expr_heap,cs) get_unboxed_tail_strict_list_indices_and_decons_uts_ident :: *CheckState -> (!Index,!Index,!Index,!Index,!Ident,!*CheckState); @@ -91,7 +91,7 @@ make_unboxed_tail_strict_list type_symbol expr_heap cs # (stdStrictLists_index,cons_uts_index,decons_uts_index,nil_uts_index,decons_uts_ident,cs) = get_unboxed_tail_strict_list_indices_and_decons_uts_ident cs # unboxed_list=UnboxedTailStrictList type_symbol stdStrictLists_index decons_uts_index nil_uts_index # (new_info_ptr,expr_heap) = newPtr EI_Empty expr_heap - # decons_expr = App {app_symb={symb_name=decons_uts_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_uts_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr} + # decons_expr = App {app_symb={symb_ident=decons_uts_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_uts_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr} = (unboxed_list,decons_expr,expr_heap,cs) get_overloaded_list_indices_and_decons_ident :: *CheckState -> (!Index,!Index,!Index,!Index,!Ident,!*CheckState); @@ -108,7 +108,7 @@ make_overloaded_list type_symbol expr_heap cs # (stdStrictLists_index,cons_index,decons_index,nil_index,decons_ident,cs) = get_overloaded_list_indices_and_decons_ident cs # overloaded_list=OverloadedList type_symbol stdStrictLists_index decons_index nil_index # (new_info_ptr,expr_heap) = newPtr EI_Empty expr_heap - # decons_expr = App {app_symb={symb_name=decons_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr} + # decons_expr = App {app_symb={symb_ident=decons_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr} = (overloaded_list,decons_expr,expr_heap,cs) make_case_guards cons_symbol type_symbol alg_patterns expr_heap cs @@ -157,21 +157,21 @@ where = ([], accus, var_store, e_info, cs) determine_function_arg (AP_Variable name var_info (Yes {bind_src, bind_dst})) var_store - = ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store) + = ({ fv_ident = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store) determine_function_arg (AP_Variable name var_info No) var_store - = ({ fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, var_store) + = ({ fv_ident = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, var_store) determine_function_arg (AP_Algebraic _ _ _ opt_var) var_store # ({bind_src,bind_dst}, var_store) = determinePatternVariable opt_var var_store - = ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store) + = ({ fv_ident = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store) determine_function_arg (AP_Basic _ opt_var) var_store # ({bind_src,bind_dst}, var_store) = determinePatternVariable opt_var var_store - = ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store) + = ({ fv_ident = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store) determine_function_arg (AP_Dynamic _ _ opt_var) var_store # ({bind_src,bind_dst}, var_store) = determinePatternVariable opt_var var_store - = ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store) + = ({ fv_ident = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store) determine_function_arg _ var_store # ({bind_src,bind_dst}, var_store) = determinePatternVariable No var_store - = ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store) + = ({ fv_ident = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store) check_function_bodies free_vars fun_args [{pb_args,pb_rhs={rhs_alts,rhs_locals},pb_position} : bodies] e_input=:{ei_expr_level,ei_mod_index} e_state=:{es_var_heap,es_fun_defs} e_info cs @@ -217,7 +217,7 @@ where transform_pattern_into_cases :: !AuxiliaryPattern !FreeVar !Expression !Position !*VarHeap !*ExpressionHeap ![DynamicPtr] !*CheckState -> (!Expression, !Position, !*VarHeap, !*ExpressionHeap, ![DynamicPtr], !*CheckState) - transform_pattern_into_cases (AP_Variable name var_info opt_var) fun_arg=:{fv_info_ptr,fv_name} result_expr pattern_position + transform_pattern_into_cases (AP_Variable name var_info opt_var) fun_arg=:{fv_info_ptr,fv_ident} result_expr pattern_position var_store expr_heap opt_dynamics cs = case opt_var of Yes {bind_src, bind_dst} @@ -225,8 +225,8 @@ where # (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap (let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap -> (Let { let_strict_binds = [], let_lazy_binds= [ - { lb_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, - lb_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, + { lb_src = Var { var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, + lb_dst = { fv_ident = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, lb_position = NoPos }], let_expr = result_expr, let_info_ptr = let_expr_ptr, let_expr_position = NoPos }, pattern_position, var_store, expr_heap, opt_dynamics, cs) @@ -234,11 +234,11 @@ where (var_expr_ptr2, expr_heap) = newPtr EI_Empty expr_heap (let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap -> (Let { let_strict_binds = [], let_lazy_binds= [ - { lb_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr1 }, - lb_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, + { lb_src = Var { var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr1 }, + lb_dst = { fv_ident = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, lb_position = NoPos }, - { lb_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr2 }, - lb_dst = { fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, + { lb_src = Var { var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr2 }, + lb_dst = { fv_ident = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, lb_position = NoPos }], let_expr = result_expr, let_info_ptr = let_expr_ptr, let_expr_position = NoPos }, pattern_position, var_store, expr_heap, opt_dynamics, cs) @@ -248,8 +248,8 @@ where # (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap (let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap -> (Let { let_strict_binds = [], let_lazy_binds= - [{ lb_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, - lb_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, + [{ lb_src = Var { var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, + lb_dst = { fv_ident = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, lb_position = NoPos }], let_expr = result_expr, let_info_ptr = let_expr_ptr, let_expr_position = NoPos }, pattern_position, var_store, expr_heap, opt_dynamics, cs) @@ -292,22 +292,22 @@ where transform_pattern_variable :: !FreeVar !(Optional (Bind Ident VarInfoPtr)) !Expression !*ExpressionHeap -> (!Expression, !Expression, !*ExpressionHeap) - transform_pattern_variable {fv_info_ptr,fv_name} (Yes {bind_src,bind_dst}) result_expr expr_heap + transform_pattern_variable {fv_info_ptr,fv_ident} (Yes {bind_src,bind_dst}) result_expr expr_heap | bind_dst == fv_info_ptr # (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap - = (Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, result_expr, expr_heap) + = (Var { var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, result_expr, expr_heap) # (var_expr_ptr1, expr_heap) = newPtr EI_Empty expr_heap (var_expr_ptr2, expr_heap) = newPtr EI_Empty expr_heap (let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap - = (Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr1 }, + = (Var { var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr1 }, Let { let_strict_binds = [], let_lazy_binds = - [{ lb_src = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr2 }, - lb_dst = { fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, + [{ lb_src = Var { var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr2 }, + lb_dst = { fv_ident = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, lb_position = NoPos }], let_expr = result_expr, let_info_ptr = let_expr_ptr, let_expr_position = NoPos }, expr_heap) - transform_pattern_variable {fv_info_ptr,fv_name} No result_expr expr_heap + transform_pattern_variable {fv_info_ptr,fv_ident} No result_expr expr_heap # (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap - = (Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, result_expr, expr_heap) + = (Var { var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, result_expr, expr_heap) checkFunctionBodies GeneratedBody function_ident_for_errors e_input e_state e_info cs = (GeneratedBody, [], e_state, e_info, cs) @@ -507,7 +507,7 @@ where = "first argument of infix operator missing" build_expression [Constant symb _ (Prio _ _) _ , _: _] e_state cs_error - = (EE, e_state, checkError symb.symb_name first_argument_of_infix_operator_missing cs_error) + = (EE, e_state, checkError symb.symb_ident first_argument_of_infix_operator_missing cs_error) build_expression [Constant symb arity _ is_fun] e_state cs_error = buildApplication symb arity 0 is_fun [] e_state cs_error build_expression [expr] e_state cs_error @@ -519,7 +519,7 @@ where Yes (symb, prio, is_fun, right) -> case right of [Constant symb _ (Prio _ _) _:_] - -> (EE, e_state, checkError symb.symb_name first_argument_of_infix_operator_missing cs_error) + -> (EE, e_state, checkError symb.symb_ident first_argument_of_infix_operator_missing cs_error) _ -> build_operator_expression [] left_expr (symb, prio, is_fun) right e_state cs_error No @@ -529,7 +529,7 @@ where # (appl_exp, e_state, cs_error) = buildApplication symb arity 0 is_fun [] e_state cs_error = split_at_operator [appl_exp : left] exprs e_state cs_error split_at_operator left [Constant symb arity (Prio _ _) is_fun] e_state cs_error - = (No, left, e_state, checkError symb.symb_name "second argument of infix operator missing" cs_error) + = (No, left, e_state, checkError symb.symb_ident "second argument of infix operator missing" cs_error) split_at_operator left [Constant symb arity prio is_fun] e_state cs_error # (appl_exp, e_state, cs_error) = buildApplication symb arity 0 is_fun [] e_state cs_error = (No, [appl_exp : left], e_state, cs_error) @@ -569,7 +569,7 @@ where -> build_operator_expression [(symb1, prio1, is_fun1, left1) : left_appls] middle_exp (symb2, prio2, is_fun2) right e_state cs_error No - -> (EE, e_state, checkError symb1.symb_name "conflicting priorities" cs_error) + -> (EE, e_state, checkError symb1.symb_ident "conflicting priorities" cs_error) No # (right, e_state, cs_error) = combine_expressions left2 [] 0 e_state cs_error (result_expr, e_state, cs_error) = buildApplication symb1 2 2 is_fun1 [left1,right] e_state cs_error @@ -586,7 +586,7 @@ where -> build_left_operand left_appls prior result_expr e_state cs_error -> (la, result_expr, e_state, cs_error) No - -> (la, EE, e_state, checkError symb.symb_name "conflicting priorities" cs_error) + -> (la, EE, e_state, checkError symb.symb_ident "conflicting priorities" cs_error) build_final_expression [] result_expr e_state cs_error = (result_expr, e_state, cs_error) @@ -848,10 +848,10 @@ where { cs & cs_error = checkError "<dynamic pattern>" "illegal combination of patterns" cs.cs_error }) transform_pattern (AP_Variable name var_info opt_var) NoPattern pattern_scheme pattern_variables No result_expr _ var_store expr_heap opt_dynamics cs = ( NoPattern, pattern_scheme, cons_optional opt_var pattern_variables, - Yes (Yes { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, result_expr), + Yes (Yes { fv_ident = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, result_expr), var_store, expr_heap, opt_dynamics, cs) transform_pattern (AP_Variable name var_info opt_var) patterns pattern_scheme pattern_variables defaul result_expr case_name var_store expr_heap opt_dynamics cs - # free_var = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 } + # free_var = { fv_ident = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 } (new_bound_var, expr_heap) = allocate_bound_var free_var expr_heap case_ident = { id_name = case_name, id_info = nilPtr } (new_case, var_store, expr_heap, cs_error) = build_and_share_case patterns defaul (Var new_bound_var) case_ident cCaseExplicit var_store expr_heap cs.cs_error @@ -960,7 +960,7 @@ where bind_pattern_variables [] pattern_expr expr_heap = (pattern_expr, [], expr_heap) bind_pattern_variables [{bind_src,bind_dst} : variables] this_pattern_expr expr_heap - # free_var = { fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 } + # free_var = { fv_ident = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 } (bound_var, expr_heap) = allocate_bound_var free_var expr_heap (pattern_expr, binds, expr_heap) = bind_pattern_variables variables (Var bound_var) expr_heap = (pattern_expr, [{lb_src = this_pattern_expr, lb_dst = free_var, lb_position = NoPos } : binds], expr_heap) @@ -998,7 +998,7 @@ checkExpression free_vars (PE_Tuple exprs) e_input e_state e_info cs # (exprs, arity, free_vars, e_state, e_info, cs) = check_expression_list free_vars exprs e_input e_state e_info cs ({glob_object={ds_ident,ds_index},glob_module}, cs) = getPredefinedGlobalSymbol (GetTupleConsIndex arity) PD_PredefinedModule STE_Constructor arity cs - = (App { app_symb = { symb_name = ds_ident, symb_kind = SK_Constructor { glob_object = ds_index, glob_module = glob_module }}, + = (App { app_symb = { symb_ident = ds_ident, symb_kind = SK_Constructor { glob_object = ds_index, glob_module = glob_module }}, app_args = exprs, app_info_ptr = nilPtr }, free_vars, e_state, e_info, cs) where check_expression_list free_vars [] e_input e_state e_info cs @@ -1013,7 +1013,7 @@ checkExpression free_vars rec=:(PE_Record record opt_type fields) e_input=:{ei_e = case opt_record_and_fields of Yes (cons=:{glob_module, glob_object}, _, new_fields) # {ds_ident,ds_index} = glob_object - rec_cons = { symb_name = ds_ident, symb_kind = SK_Constructor { glob_object = ds_index, glob_module = glob_module } } + rec_cons = { symb_ident = ds_ident, symb_kind = SK_Constructor { glob_object = ds_index, glob_module = glob_module } } -> case record of PE_Empty # (exprs, free_vars, e_state, e_info, cs) = check_field_exprs free_vars new_fields 0 RK_Constructor e_input e_state e_info cs @@ -1037,12 +1037,12 @@ where = ([expr : exprs], free_vars, e_state, e_info, cs) check_field_expr :: [FreeVar] (Bind ParsedExpr (Global FieldSymbol)) Int RecordKind ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!.Bind Expression (Global FieldSymbol),![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState); - check_field_expr free_vars field=:{bind_src = PE_Empty, bind_dst={glob_object={fs_var,fs_name,fs_index},glob_module}} field_nr record_kind e_input e_state e_info cs + check_field_expr free_vars field=:{bind_src = PE_Empty, bind_dst={glob_object={fs_var,fs_ident,fs_index},glob_module}} field_nr record_kind e_input e_state e_info cs # (expr, free_vars, e_state, e_info, cs) = checkIdentExpression cIsNotInExpressionList free_vars fs_var e_input e_state e_info cs = ({ field & bind_src = expr }, free_vars, e_state, e_info, cs) - check_field_expr free_vars field=:{bind_src = PE_WildCard, bind_dst={glob_object=fs_name}} field_nr RK_Constructor e_input e_state e_info cs - = ({ field & bind_src = NoBind nilPtr }, free_vars, e_state, e_info, { cs & cs_error = checkError fs_name "field not specified" cs.cs_error }) + check_field_expr free_vars field=:{bind_src = PE_WildCard, bind_dst={glob_object=fs_ident}} field_nr RK_Constructor e_input e_state e_info cs + = ({ field & bind_src = NoBind nilPtr }, free_vars, e_state, e_info, { cs & cs_error = checkError fs_ident "field not specified" cs.cs_error }) check_field_expr free_vars field=:{bind_src = PE_WildCard} field_nr RK_Update e_input e_state=:{es_expr_heap} e_info cs # (bind_expr_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap = ({ field & bind_src = NoBind bind_expr_ptr }, free_vars, { e_state & es_expr_heap = es_expr_heap }, e_info, cs) @@ -1091,7 +1091,7 @@ where Var var -> ({ bind_dst = var, bind_src = bind_src }, (free_vars, e_state, e_info, cs)) _ - -> ({ bind_dst = { var_name = bind_dst, var_info_ptr = nilPtr, var_expr_ptr = nilPtr }, bind_src = bind_src }, (free_vars, e_state, e_info, + -> ({ bind_dst = { var_ident = bind_dst, var_info_ptr = nilPtr, var_expr_ptr = nilPtr }, bind_src = bind_src }, (free_vars, e_state, e_info, { cs & cs_error = checkError bind_src "bound variable expected" cs.cs_error })) check_out_parameters expr_level params es_cs @@ -1102,9 +1102,9 @@ where # (entry, cs_symbol_table) = readPtr bind_dst.id_info cs.cs_symbol_table # (new_info_ptr, es_var_heap) = newPtr VI_Empty e_state.es_var_heap cs = checkPatternVariable expr_level entry bind_dst new_info_ptr { cs & cs_symbol_table = cs_symbol_table } - = ( { bind & bind_dst = { fv_def_level = expr_level, fv_name = bind_dst, fv_info_ptr = new_info_ptr, fv_count = 0 }}, + = ( { bind & bind_dst = { fv_def_level = expr_level, fv_ident = bind_dst, fv_info_ptr = new_info_ptr, fv_count = 0 }}, ( { e_state & es_var_heap = es_var_heap }, cs)) - = ( { bind & bind_dst = { fv_def_level = expr_level, fv_name = bind_dst, fv_info_ptr = nilPtr, fv_count = 0 }}, + = ( { bind & bind_dst = { fv_def_level = expr_level, fv_ident = bind_dst, fv_info_ptr = nilPtr, fv_count = 0 }}, ( e_state, { cs & cs_error = checkError bind_src "variable expected" cs.cs_error })) remove_out_parameters_from_symbol_table expr_level idents symbol_table @@ -1157,7 +1157,7 @@ checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_stat ([generic_info_expr], es_expr_heap, cs) ([], es_expr_heap, cs) #! symb_kind = SK_Generic { glob_object = gen_index, glob_module = mod_index} kind - #! symbol = { symb_name = id, symb_kind = symb_kind } + #! symbol = { symb_ident = id, symb_kind = symb_kind } #! (new_info_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap #! app = { app_symb = symbol, app_args = app_args, app_info_ptr = new_info_ptr } #! e_state = { e_state & es_expr_heap = es_expr_heap } @@ -1171,7 +1171,7 @@ checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_stat #! (new_info_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap #! app = { app_symb = - { symb_name = pds_ident + { symb_ident = pds_ident , symb_kind = SK_Constructor {glob_module=pds_module, glob_object=pds_def} } , app_args = [] @@ -1239,11 +1239,11 @@ where = (EE, free_vars, e_state, e_info, { cs & cs_error = checkError id "undefined" cs_error }) check_id_expression {ste_kind = STE_Variable info_ptr,ste_def_level} is_expr_list free_vars id e_input=:{ei_fun_level} e_state=:{es_expr_heap} e_info cs | ste_def_level < ei_fun_level - # free_var = { fv_def_level = ste_def_level, fv_name = id, fv_info_ptr = info_ptr, fv_count = 0 } + # free_var = { fv_def_level = ste_def_level, fv_ident = id, fv_info_ptr = info_ptr, fv_count = 0 } (free_var_added, free_vars) = newFreeVariable free_var free_vars = (FreeVar free_var, free_vars, e_state, e_info, cs) #! (var_expr_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap - = (Var {var_name = id, var_info_ptr = info_ptr, var_expr_ptr = var_expr_ptr}, free_vars, + = (Var {var_ident = id, var_info_ptr = info_ptr, var_expr_ptr = var_expr_ptr}, free_vars, {e_state & es_expr_heap = es_expr_heap}, e_info, cs) check_id_expression {ste_kind = STE_Generic} is_expr_list free_vars id e_input e_state e_info cs=:{cs_error} = (EE, free_vars, e_state, e_info, @@ -1253,7 +1253,7 @@ where { cs & cs_error = checkError id "generic: missing kind argument" cs_error}) check_id_expression entry is_expr_list free_vars id=:{id_info} e_input e_state e_info cs # (symb_kind, arity, priority, is_a_function, e_state, e_info, cs) = determine_info_of_symbol entry id_info e_input e_state e_info cs - symbol = { symb_name = id, symb_kind = symb_kind } + symbol = { symb_ident = id, symb_kind = symb_kind } | is_expr_list = (Constant symbol arity priority is_a_function, free_vars, e_state, e_info, cs) # (app_expr, e_state, cs_error) = buildApplication symbol arity 0 is_a_function [] e_state cs.cs_error @@ -1264,7 +1264,7 @@ where determine_info_of_symbol entry=:{ste_kind=STE_FunctionOrMacro calls,ste_index,ste_def_level} symb_info e_input=:{ei_fun_index} e_state=:{es_calls} e_info cs=:{cs_symbol_table,cs_x} # (fun_def,e_state) = e_state!es_fun_defs.[ste_index] - # {fun_symb,fun_arity,fun_kind,fun_priority,fun_info={fi_properties}}=fun_def + # {fun_ident,fun_arity,fun_kind,fun_priority,fun_info={fi_properties}}=fun_def # index = { glob_object = ste_index, glob_module = cs_x.x_main_dcl_module_n } # symbol_kind = convert_DefOrImpFunKind_to_icl_SymbKind fun_kind index fi_properties | is_called_before ei_fun_index calls @@ -1275,7 +1275,7 @@ where determine_info_of_symbol entry=:{ste_kind=STE_DclMacroOrLocalMacroFunction calls,ste_index,ste_def_level} symb_info e_input=:{ei_fun_index, ei_mod_index} e_state=:{es_calls} e_info cs=:{cs_symbol_table} # (macro_def,e_info) = e_info!ef_macro_defs.[ei_mod_index,ste_index] - # {fun_symb,fun_arity,fun_kind,fun_priority,fun_info={fi_properties}}=macro_def + # {fun_ident,fun_arity,fun_kind,fun_priority,fun_info={fi_properties}}=macro_def # index = { glob_object = ste_index, glob_module = ei_mod_index } # symbol_kind = convert_DefOrImpFunKind_to_dcl_SymbKind fun_kind index fi_properties | is_called_before ei_fun_index calls @@ -1286,7 +1286,7 @@ where determine_info_of_symbol entry=:{ste_kind=STE_Imported (STE_DclMacroOrLocalMacroFunction calls) macro_mod_index,ste_index,ste_def_level} symb_info e_input=:{ei_fun_index} e_state=:{es_calls} e_info cs=:{cs_symbol_table} # (macro_def,e_info) = e_info!ef_macro_defs.[macro_mod_index,ste_index] - # {fun_symb,fun_arity,fun_kind,fun_priority,fun_info={fi_properties}}=macro_def + # {fun_ident,fun_arity,fun_kind,fun_priority,fun_info={fi_properties}}=macro_def # index = { glob_object = ste_index, glob_module = macro_mod_index } # symbol_kind = convert_DefOrImpFunKind_to_dcl_SymbKind fun_kind index fi_properties | is_called_before ei_fun_index calls @@ -1598,17 +1598,17 @@ checkPattern (PE_ArrayPattern selections) opt_var p_input (var_env, array_patter checkPattern expr opt_var p_input accus ps e_info cs = abort "checkPattern: do not know how to handle pattern" ---> expr -checkMacroPatternConstructor macro=:{fun_symb,fun_arity,fun_kind,fun_priority} macro_mod_index mod_index is_dcl_macro is_expr_list ste_index ident opt_var ps e_info cs=:{cs_error} +checkMacroPatternConstructor macro=:{fun_ident,fun_arity,fun_kind,fun_priority} macro_mod_index mod_index is_dcl_macro is_expr_list ste_index ident opt_var ps e_info cs=:{cs_error} | case fun_kind of FK_Macro->True; _ -> False | is_expr_list - # macro_symbol = { glob_object = MakeDefinedSymbol fun_symb ste_index fun_arity, glob_module = macro_mod_index } + # macro_symbol = { glob_object = MakeDefinedSymbol fun_ident ste_index fun_arity, glob_module = macro_mod_index } = (AP_Constant (APK_Macro is_dcl_macro) macro_symbol fun_priority, ps, e_info, cs) | fun_arity == 0 # (pattern, ps, ef_modules, ef_cons_defs, cs_error) = unfoldPatternMacro macro mod_index [] opt_var ps e_info.ef_modules e_info.ef_cons_defs cs_error = (pattern, ps, { e_info & ef_modules = ef_modules, ef_cons_defs = ef_cons_defs }, { cs & cs_error = cs_error }) = (AP_Empty ident, ps, e_info, { cs & cs_error = checkError ident "not defined" cs_error }) - = (AP_Empty ident, ps, e_info, { cs & cs_error = checkError fun_symb "not allowed in a pattern" cs_error }) + = (AP_Empty ident, ps, e_info, { cs & cs_error = checkError fun_ident "not allowed in a pattern" cs_error }) checkPatternConstructor :: !Index !Bool !SymbolTableEntry !Ident !(Optional (Bind Ident VarInfoPtr)) !*PatternState !*ExpressionInfo !*CheckState -> (!AuxiliaryPattern, !*PatternState, !*ExpressionInfo, !*CheckState); @@ -1623,17 +1623,17 @@ checkPatternConstructor mod_index is_expr_list {ste_kind = STE_DclMacroOrLocalMa checkPatternConstructor mod_index is_expr_list {ste_kind = STE_Imported (STE_DclMacroOrLocalMacroFunction _) macro_module_index,ste_index} ident opt_var ps e_info cs # (macro,e_info) = e_info!ef_macro_defs.[macro_module_index,ste_index] = checkMacroPatternConstructor macro macro_module_index mod_index True is_expr_list ste_index ident opt_var ps e_info cs -checkPatternConstructor mod_index is_expr_list {ste_index, ste_kind} cons_symb opt_var ps +checkPatternConstructor mod_index is_expr_list {ste_index, ste_kind} cons_ident opt_var ps e_info=:{ef_cons_defs,ef_modules} cs=:{cs_error} # (cons_index, cons_module, cons_arity, cons_priority, cons_type_index, ef_cons_defs, ef_modules, cs_error) - = determine_pattern_symbol mod_index ste_index ste_kind cons_symb.id_name ef_cons_defs ef_modules cs_error + = determine_pattern_symbol mod_index ste_index ste_kind cons_ident.id_name ef_cons_defs ef_modules cs_error e_info = { e_info & ef_cons_defs = ef_cons_defs, ef_modules = ef_modules } - cons_symbol = { glob_object = MakeDefinedSymbol cons_symb cons_index cons_arity, glob_module = cons_module } + cons_symbol = { glob_object = MakeDefinedSymbol cons_ident cons_index cons_arity, glob_module = cons_module } | is_expr_list = (AP_Constant (APK_Constructor cons_type_index) cons_symbol cons_priority, ps, e_info, { cs & cs_error = cs_error }) | cons_arity == 0 = (AP_Algebraic cons_symbol cons_type_index [] opt_var, ps, e_info, { cs & cs_error = cs_error }) - = (AP_Algebraic cons_symbol cons_type_index [] opt_var, ps, e_info, { cs & cs_error = checkError cons_symb "constructor arguments are missing" cs_error }) + = (AP_Algebraic cons_symbol cons_type_index [] opt_var, ps, e_info, { cs & cs_error = checkError cons_ident "constructor arguments are missing" cs_error }) where determine_pattern_symbol mod_index id_index STE_Constructor id_name cons_defs modules error # ({cons_type={st_arity},cons_priority, cons_type_index}, cons_defs) = cons_defs![id_index] @@ -1692,14 +1692,14 @@ convertSubPatterns [pattern : patterns] result_expr pattern_position var_store e convertSubPattern :: AuxiliaryPattern Expression Position *(Heap VarInfo) *(Heap ExprInfo) u:[Ptr ExprInfo] *CheckState -> *(!FreeVar,!Expression,!Position,!*Heap VarInfo,!*Heap ExprInfo,!u:[Ptr ExprInfo],!*CheckState); convertSubPattern (AP_Variable name var_info (Yes {bind_src,bind_dst})) result_expr pattern_position var_store expr_heap opt_dynamics cs # (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap - bound_var = { var_name = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr } - free_var = { fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 } + bound_var = { var_ident = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr } + free_var = { fv_ident = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 } (let_expr, expr_heap) = buildLetExpression [] [{lb_src = Var bound_var, - lb_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, + lb_dst = { fv_ident = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, lb_position = NoPos }] result_expr NoPos expr_heap = (free_var, let_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs) convertSubPattern (AP_Variable name var_info No) result_expr pattern_position var_store expr_heap opt_dynamics cs - = ({ fv_name = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, result_expr, pattern_position, + = ({ fv_ident = name, fv_info_ptr = var_info, fv_def_level = NotALevel, fv_count = 0 }, result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs) convertSubPattern (AP_Algebraic cons_symbol type_index args opt_var) result_expr pattern_position var_store expr_heap opt_dynamics cs @@ -1711,8 +1711,8 @@ convertSubPattern (AP_Algebraic cons_symbol type_index args opt_var) result_expr (case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap # alg_patterns = [{ ap_symbol = cons_symbol, ap_vars = var_args, ap_expr = result_expr, ap_position = pattern_position }] # (case_guards,expr_heap,cs) = make_case_guards cons_symbol type_symbol alg_patterns expr_heap cs - = ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, - Case { case_expr = Var { var_name = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr }, + = ({ fv_ident = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, + Case { case_expr = Var { var_ident = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr }, case_guards = case_guards, case_default = No, case_ident = No, case_info_ptr = case_expr_ptr, case_explicit = cCaseNotExplicit, case_default_pos = NoPos }, @@ -1723,8 +1723,8 @@ convertSubPattern (AP_Basic basic_val opt_var) result_expr pattern_position var_ ({bind_src,bind_dst}, var_store) = determinePatternVariable opt_var var_store (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap (case_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap - = ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, - Case { case_expr = Var { var_name = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr }, + = ({ fv_ident = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, + Case { case_expr = Var { var_ident = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr }, case_guards = case_guards, case_default = No, case_ident = No, case_info_ptr = case_expr_ptr, case_explicit = cCaseNotExplicit, case_default_pos = NoPos}, @@ -1738,13 +1738,13 @@ convertSubPattern (AP_Dynamic pattern type opt_var) result_expr pattern_position (dynamic_info_ptr, expr_heap) = newPtr (EI_DynamicType type opt_dynamics) expr_heap type_case_patterns = [{ dp_var = var_arg, dp_type = dynamic_info_ptr, dp_rhs = result_expr, dp_type_patterns_vars = [], dp_type_code = TCE_Empty, dp_position = pattern_position }] - = ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, - buildTypeCase (Var { var_name = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr }) + = ({ fv_ident = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, + buildTypeCase (Var { var_ident = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr }) type_case_patterns No type_case_info_ptr cCaseNotExplicit, NoPos, var_store, expr_heap, [dynamic_info_ptr], cs) convertSubPattern (AP_WildCard opt_var) result_expr pattern_position var_store expr_heap opt_dynamics cs # ({bind_src,bind_dst}, var_store) = determinePatternVariable opt_var var_store - = ({ fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, result_expr, pattern_position, + = ({ fv_ident = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs) convertSubPattern (AP_Empty _) result_expr pattern_position var_store expr_heap opt_dynamics cs = convertSubPattern (AP_WildCard No) EE pattern_position var_store expr_heap opt_dynamics cs @@ -1765,7 +1765,7 @@ checkAndTransformPatternIntoBind free_vars [] e_input e_state e_info cs transfromPatternIntoBind :: !Index !Level !AuxiliaryPattern !Expression !Position !*VarHeap !*ExpressionHeap !*ExpressionInfo !*CheckState -> *(![LetBind], !*VarHeap, !*ExpressionHeap, !*ExpressionInfo, !*CheckState) transfromPatternIntoBind mod_index def_level (AP_Variable name var_info _) src_expr position var_store expr_heap e_info cs - # bind = {lb_src = src_expr, lb_dst = { fv_name = name, fv_info_ptr = var_info, fv_def_level = def_level, fv_count = 0 }, lb_position = position } + # bind = {lb_src = src_expr, lb_dst = { fv_ident = name, fv_info_ptr = var_info, fv_def_level = def_level, fv_count = 0 }, lb_position = position } = ([bind], var_store, expr_heap, e_info, cs) transfromPatternIntoBind mod_index def_level (AP_Algebraic cons_symbol=:{glob_module,glob_object=ds_cons=:{ds_arity, ds_index, ds_ident}} type_index args opt_var) src_expr position var_store expr_heap e_info=:{ef_type_defs,ef_modules} cs @@ -1802,17 +1802,17 @@ transfromPatternIntoBind mod_index def_level (AP_Algebraic cons_symbol=:{glob_mo | pd_cons_index==PD_UnboxedConsSymbol # (stdStrictLists_index,_,decons_u_index,_,decons_u_ident,cs) = get_unboxed_list_indices_and_decons_u_ident cs # (new_info_ptr,expr_heap) = newPtr EI_Empty expr_heap - # decons_u_expr = App {app_symb={symb_name=decons_u_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_u_index,glob_module=stdStrictLists_index}},app_args=[src_expr],app_info_ptr=new_info_ptr} + # decons_u_expr = App {app_symb={symb_ident=decons_u_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_u_index,glob_module=stdStrictLists_index}},app_args=[src_expr],app_info_ptr=new_info_ptr} = (decons_u_expr,expr_heap,cs) | pd_cons_index==PD_UnboxedTailStrictConsSymbol # (stdStrictLists_index,_,decons_uts_index,_,decons_uts_ident,cs) = get_unboxed_tail_strict_list_indices_and_decons_uts_ident cs # (new_info_ptr,expr_heap) = newPtr EI_Empty expr_heap - # decons_uts_expr = App {app_symb={symb_name=decons_uts_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_uts_index,glob_module=stdStrictLists_index}},app_args=[src_expr],app_info_ptr=new_info_ptr} + # decons_uts_expr = App {app_symb={symb_ident=decons_uts_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_uts_index,glob_module=stdStrictLists_index}},app_args=[src_expr],app_info_ptr=new_info_ptr} = (decons_uts_expr,expr_heap,cs) | pd_cons_index==PD_OverloadedConsSymbol # (stdStrictLists_index,_,decons_index,_,decons_ident,cs) = get_overloaded_list_indices_and_decons_ident cs # (new_info_ptr,expr_heap) = newPtr EI_Empty expr_heap - # decons_expr = App {app_symb={symb_name=decons_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_index,glob_module=stdStrictLists_index}},app_args=[src_expr],app_info_ptr=new_info_ptr} + # decons_expr = App {app_symb={symb_ident=decons_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_index,glob_module=stdStrictLists_index}},app_args=[src_expr],app_info_ptr=new_info_ptr} = (decons_expr,expr_heap,cs) = (src_expr,expr_heap,cs) = (src_expr,expr_heap,cs) @@ -1847,8 +1847,8 @@ where transform_sub_patterns_of_record mod_index def_level [pattern : patterns] fields field_module field_index record_expr all_binds position var_store expr_heap e_info cs - # {fs_name, fs_index} = fields.[field_index] - selector = { glob_module = field_module, glob_object = MakeDefinedSymbol fs_name fs_index 1} + # {fs_ident, fs_index} = fields.[field_index] + selector = { glob_module = field_module, glob_object = MakeDefinedSymbol fs_ident fs_index 1} (this_record_expr, expr_heap) = adjust_match_expression record_expr expr_heap (binds, var_store, expr_heap, e_info, cs) = transfromPatternIntoBind mod_index def_level pattern (Selection NormalSelector this_record_expr [ RecordSelection selector field_index ]) @@ -1859,9 +1859,9 @@ where = (binds, var_store, expr_heap, e_info, cs) bind_opt_var (Yes {bind_src,bind_dst}) src_expr position var_heap expr_heap - # free_var = { fv_name = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 } + # free_var = { fv_ident = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 } (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap - bound_var = { var_name = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr } + bound_var = { var_ident = bind_src, var_info_ptr = bind_dst, var_expr_ptr = var_expr_ptr } = (Var bound_var, [{lb_src = src_expr, lb_dst = free_var, lb_position = position}], var_heap <:= (bind_dst, VI_Empty), expr_heap) bind_opt_var No src_expr _ var_heap expr_heap = (src_expr, [], var_heap, expr_heap) @@ -1872,8 +1872,8 @@ where # new_name = newVarId "_x" (var_info_ptr, var_heap) = newPtr VI_Empty var_heap // (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap - bound_var = { var_name = new_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr } - free_var = { fv_name = new_name, fv_info_ptr = var_info_ptr, fv_def_level = def_level, fv_count = 0 } + bound_var = { var_ident = new_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr } + free_var = { fv_ident = new_name, fv_info_ptr = var_info_ptr, fv_def_level = def_level, fv_count = 0 } = (Var bound_var, [{lb_src = match_expr, lb_dst = free_var, lb_position = position } : opt_var_bind], var_heap, expr_heap) adjust_match_expression (Var var) expr_heap @@ -1894,9 +1894,9 @@ unfoldPatternMacro macro=:{fun_body=TransformedBody {tb_args,tb_rhs}} mod_index (all_macro_args, []) (splitAt length_macro_args all_macro_args) ums = { ums_var_heap = fold2St bind_var tb_args macro_args ps_var_heap, ums_modules = modules, ums_cons_defs = cons_defs, ums_error = error } - (pattern, {ums_var_heap,ums_modules,ums_cons_defs,ums_error}) = unfold_pattern_macro mod_index macro.fun_symb opt_var extra_args tb_rhs ums + (pattern, {ums_var_heap,ums_modules,ums_cons_defs,ums_error}) = unfold_pattern_macro mod_index macro.fun_ident opt_var extra_args tb_rhs ums = (pattern, { ps & ps_var_heap = ums_var_heap}, ums_modules, ums_cons_defs, ums_error) - = (AP_Empty macro.fun_symb, { ps & ps_var_heap = ps_var_heap}, modules, cons_defs, checkError macro.fun_symb "sharing not allowed" error) + = (AP_Empty macro.fun_ident, { ps & ps_var_heap = ps_var_heap}, modules, cons_defs, checkError macro.fun_ident "sharing not allowed" error) where no_sharing [{fv_count} : args] = fv_count <= 1 && no_sharing args @@ -1906,7 +1906,7 @@ where bind_var {fv_info_ptr} pattern ps_var_heap = ps_var_heap <:= (fv_info_ptr, VI_Pattern pattern) - unfold_pattern_macro mod_index macro_ident _ extra_args (Var {var_name,var_info_ptr}) ums=:{ums_var_heap, ums_error} + unfold_pattern_macro mod_index macro_ident _ extra_args (Var {var_ident,var_info_ptr}) ums=:{ums_var_heap, ums_error} | not (isEmpty extra_args) = (AP_Empty macro_ident, { ums & ums_error = checkError macro_ident "too much arguments for pattern macro" ums_error }) # (VI_Pattern pattern, ums_var_heap) = readPtr var_info_ptr ums_var_heap @@ -1914,15 +1914,15 @@ where unfold_pattern_macro mod_index macro_ident opt_var extra_args (App {app_symb,app_args}) ums = unfold_application mod_index macro_ident opt_var extra_args app_symb app_args ums where - unfold_application mod_index macro_ident opt_var extra_args {symb_kind=SK_Constructor {glob_module,glob_object},symb_name} app_args + unfold_application mod_index macro_ident opt_var extra_args {symb_kind=SK_Constructor {glob_module,glob_object},symb_ident} app_args ums=:{ums_cons_defs, ums_modules,ums_error} # (cons_def, cons_index, ums_cons_defs, ums_modules) = get_cons_def mod_index glob_module glob_object ums_cons_defs ums_modules | cons_def.cons_type.st_arity == length app_args+length extra_args # (patterns, ums) = mapSt (unfold_pattern_macro mod_index macro_ident No []) app_args { ums & ums_cons_defs = ums_cons_defs, ums_modules = ums_modules } - cons_symbol = { glob_object = MakeDefinedSymbol symb_name cons_index cons_def.cons_type.st_arity, glob_module = glob_module } + cons_symbol = { glob_object = MakeDefinedSymbol symb_ident cons_index cons_def.cons_type.st_arity, glob_module = glob_module } = (AP_Algebraic cons_symbol cons_def.cons_type_index (patterns++extra_args) opt_var, ums) - = (AP_Empty cons_def.cons_symb, { ums & ums_cons_defs = ums_cons_defs, ums_modules = ums_modules, - ums_error = checkError cons_def.cons_symb "wrong number of arguments" ums_error }) + = (AP_Empty cons_def.cons_ident, { ums & ums_cons_defs = ums_cons_defs, ums_modules = ums_modules, + ums_error = checkError cons_def.cons_ident "wrong number of arguments" ums_error }) get_cons_def mod_index cons_mod cons_index cons_defs modules | mod_index == cons_mod @@ -1939,7 +1939,7 @@ where unfold_pattern_macro mod_index macro_ident opt_var _ expr ums=:{ums_error} = (AP_Empty macro_ident, { ums & ums_error = checkError macro_ident "illegal rhs for a pattern macro" ums_error }) unfoldPatternMacro macro mod_index all_macro_args opt_var ps=:{ps_var_heap} modules cons_defs error - = (AP_Empty macro.fun_symb, { ps & ps_var_heap = ps_var_heap}, modules, cons_defs, checkError macro.fun_symb "illegal macro in pattern" error) + = (AP_Empty macro.fun_ident, { ps & ps_var_heap = ps_var_heap}, modules, cons_defs, checkError macro.fun_ident "illegal macro in pattern" error) checkSelectors end_with_update free_vars [ selector : selectors ] e_input e_state e_info cs | isEmpty selectors @@ -2175,7 +2175,7 @@ buildSelections e_input {ap_opt_var, ap_array_var, ap_selections} = case ap_opt_var of Yes { bind_src = opt_var_ident, bind_dst = opt_var_var_info_ptr } # (bound_array_var, es_expr_heap) = allocate_bound_var ap_array_var e_state.es_expr_heap - free_var = { fv_name = opt_var_ident, fv_info_ptr = opt_var_var_info_ptr, fv_def_level = NotALevel, + free_var = { fv_ident = opt_var_ident, fv_info_ptr = opt_var_var_info_ptr, fv_def_level = NotALevel, fv_count = 0 } -> ([{ lb_dst = free_var, lb_src = Var bound_array_var, lb_position = NoPos }: lazy_binds], { e_state & es_expr_heap = es_expr_heap }) @@ -2186,7 +2186,7 @@ buildSelections e_input {ap_opt_var, ap_array_var, ap_selections} # (var_for_uselect_result, es_var_heap) = allocate_free_var { id_name = "_x", id_info = nilPtr } e_state.es_var_heap (new_array_var, es_var_heap) - = allocate_free_var ap_array_var.fv_name es_var_heap + = allocate_free_var ap_array_var.fv_ident es_var_heap (bound_array_var, es_expr_heap) = allocate_bound_var ap_array_var e_state.es_expr_heap (bound_var_for_uselect_result, es_expr_heap) @@ -2246,11 +2246,11 @@ buildApplication symbol form_arity act_arity is_fun args e_state=:{es_expr_heap} = (App app, { e_state & es_expr_heap = es_expr_heap }, error) # app = App { app_symb = symbol , app_args = args, app_info_ptr = nilPtr } | form_arity < act_arity - = (app, e_state, checkError symbol.symb_name "used with too many arguments" error) + = (app, e_state, checkError symbol.symb_ident "used with too many arguments" error) = (app, e_state, error) -buildPattern mod_index (APK_Constructor type_index) cons_symb args opt_var ps e_info cs - = (AP_Algebraic cons_symb type_index args opt_var, ps, e_info, cs) +buildPattern mod_index (APK_Constructor type_index) cons_ident args opt_var ps e_info cs + = (AP_Algebraic cons_ident type_index args opt_var, ps, e_info, cs) buildPattern mod_index (APK_Macro is_dcl_macro) {glob_module,glob_object} args opt_var ps e_info=:{ef_modules,ef_macro_defs,ef_cons_defs} cs=:{cs_error} | is_dcl_macro # (macro,ef_macro_defs) = ef_macro_defs![glob_module,glob_object.ds_index] @@ -2325,15 +2325,15 @@ pushErrorAdmin2 string pos=:(LinePos _ _) cs allocate_bound_var :: !FreeVar !*ExpressionHeap -> (!BoundVar, !.ExpressionHeap) -allocate_bound_var {fv_name, fv_info_ptr} expr_heap +allocate_bound_var {fv_ident, fv_info_ptr} expr_heap # (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap - = ({ var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, expr_heap) + = ({ var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, expr_heap) allocate_free_var ident var_heap # (new_var_info_ptr, var_heap) = newPtr VI_Empty var_heap - = ({ fv_def_level = NotALevel, fv_name = ident, fv_info_ptr = new_var_info_ptr, fv_count = 0 }, var_heap) + = ({ fv_def_level = NotALevel, fv_ident = ident, fv_info_ptr = new_var_info_ptr, fv_count = 0 }, var_heap) diff --git a/frontend/checkKindCorrectness.icl b/frontend/checkKindCorrectness.icl index b7d118b..ceee1aa 100644 --- a/frontend/checkKindCorrectness.icl +++ b/frontend/checkKindCorrectness.icl @@ -57,7 +57,7 @@ checkKindCorrectness main_dcl_module_n first_uncached_function icl_instances com = { dcl_mods & [mod_index].dcl_common.com_class_defs = { el \\ el <- class_defs_with_cacheable_kind_info }} = (dcl_mods, th_vars, td_infos, error_admin) - check_class com_member_defs class_def=:{class_name, class_args, class_members} + check_class com_member_defs class_def=:{class_ident, class_args, class_members} (class_defs_accu, th_vars, td_infos, error_admin) # th_vars = init_type_vars class_args th_vars @@ -70,10 +70,10 @@ checkKindCorrectness main_dcl_module_n first_uncached_function icl_instances com = mapFilterYesSt get_opt_kind class_args th_vars = ([{ class_def & class_arg_kinds = derived_kinds }:class_defs_accu], th_vars, td_infos, error_admin) check_member_without_context class_args - {me_symb, me_pos, me_class_vars, me_type=me_type=:{st_vars, st_args, st_result}} + {me_ident, me_pos, me_class_vars, me_type=me_type=:{st_vars, st_args, st_result}} (th_vars, td_infos, error_admin) # error_admin - = setErrorAdmin (newPosition me_symb me_pos) error_admin + = setErrorAdmin (newPosition me_ident me_pos) error_admin th_vars = init_type_vars st_vars th_vars th_vars @@ -137,7 +137,7 @@ checkKindCorrectness main_dcl_module_n first_uncached_function icl_instances com = mapSt get_tvi class_args th_vars = (expected_kinds, bv_uninitialized_mods, th_vars) - write_kind_info {class_name, class_args, class_arg_kinds} th_vars + write_kind_info {class_ident, class_args, class_arg_kinds} th_vars = write_ki class_args class_arg_kinds th_vars write_ki [{tv_info_ptr}:class_args] [class_arg_kind:class_arg_kinds] th_vars @@ -153,10 +153,10 @@ checkKindCorrectness main_dcl_module_n first_uncached_function icl_instances com possibly_check_type (TVI_Kind expected_kind) arg_nr type state = check_type expected_kind arg_nr type state check_class_context_and_member_contexts common_defs com_member_defs - {class_name, class_pos, class_context, class_members, class_args} + {class_ident, class_pos, class_context, class_members, class_args} (bv_uninitialized_mods, th_vars, td_infos, error_admin) # error_admin - = setErrorAdmin (newPosition class_name class_pos) error_admin + = setErrorAdmin (newPosition class_ident class_pos) error_admin state = foldSt (check_context common_defs) class_context (bv_uninitialized_mods, th_vars, td_infos, error_admin) @@ -166,10 +166,10 @@ checkKindCorrectness main_dcl_module_n first_uncached_function icl_instances com = state check_member_context common_defs com_member_defs {ds_index} (bv_uninitialized_mods, th_vars, td_infos, error_admin) - # {me_symb, me_pos, me_type} + # {me_ident, me_pos, me_type} = com_member_defs.[ds_index] error_admin - = setErrorAdmin (newPosition me_symb me_pos) error_admin + = setErrorAdmin (newPosition me_ident me_pos) error_admin = foldSt (check_context common_defs) me_type.st_context (bv_uninitialized_mods, th_vars, td_infos, error_admin) get_tvi {tv_info_ptr} th_vars @@ -190,7 +190,7 @@ checkKindCorrectness main_dcl_module_n first_uncached_function icl_instances com -> (fun_defs, bv_uninitialized_mods, th_vars, td_infos, error_admin) Yes st # (bv_uninitialized_mods, th_vars, td_infos, error_admin) - = check_symbol_type common_defs fun_def.fun_symb fun_def.fun_pos + = check_symbol_type common_defs fun_def.fun_ident fun_def.fun_pos st (bv_uninitialized_mods, th_vars, td_infos, error_admin) -> (fun_defs, bv_uninitialized_mods, th_vars, td_infos, error_admin) check_dcl_functions common_defs mod_index @@ -201,16 +201,16 @@ checkKindCorrectness main_dcl_module_n first_uncached_function icl_instances com = iFoldSt (\i state -> if (in_index_range i dcl_instances || in_index_range i dcl_macros) // yawn state - (let ({ft_symb, ft_pos, ft_type}) = dcl_functions.[i] - in check_symbol_type common_defs ft_symb ft_pos ft_type + (let ({ft_ident, ft_pos, ft_type}) = dcl_functions.[i] + in check_symbol_type common_defs ft_ident ft_pos ft_type state)) 0 (size dcl_functions) (bv_uninitialized_mods, th_vars, td_infos, error_admin) = (dcl_mods, bv_uninitialized_mods, th_vars, td_infos, error_admin) - check_symbol_type common_defs fun_symb fun_pos + check_symbol_type common_defs fun_ident fun_pos st=:{st_vars, st_args, st_result, st_context} (bv_uninitialized_mods, th_vars, td_infos, error_admin) # error_admin - = setErrorAdmin (newPosition fun_symb fun_pos) error_admin + = setErrorAdmin (newPosition fun_ident fun_pos) error_admin th_vars = init_type_vars st_vars th_vars (th_vars, td_infos, error_admin) @@ -222,7 +222,7 @@ checkKindCorrectness main_dcl_module_n first_uncached_function icl_instances com = (bv_uninitialized_mods, th_vars, td_infos, error_admin) check_atype expected_kind arg_nr {at_type} state = check_type expected_kind arg_nr at_type state - check_type expected_kind arg_nr (TA {type_name,type_index} args) + check_type expected_kind arg_nr (TA {type_ident,type_index} args) (th_vars, td_infos, error_admin) # ({tdi_kinds}, td_infos) = td_infos![type_index.glob_module,type_index.glob_object] @@ -304,7 +304,7 @@ checkKindCorrectness main_dcl_module_n first_uncached_function icl_instances com init_type_var {tv_info_ptr} tv_heap = tv_heap <:= (tv_info_ptr, TVI_Empty) - unify_var_kinds expected_kind tv=:{tv_name, tv_info_ptr} th_vars error_admin + unify_var_kinds expected_kind tv=:{tv_ident, tv_info_ptr} th_vars error_admin # (tvi, th_vars) = readPtr tv_info_ptr th_vars = case tvi of @@ -314,7 +314,7 @@ checkKindCorrectness main_dcl_module_n first_uncached_function icl_instances com | expected_kind==kind -> (th_vars, error_admin) -> (th_vars, checkError "cannot consistently assign a kind to type variable" - tv_name.id_name error_admin) + tv_ident.id_name error_admin) check_equality_of_kinds arg_nr expected_kind kind error_admin | expected_kind==kind = error_admin diff --git a/frontend/checksupport.icl b/frontend/checksupport.icl index 2c162c7..0e2ae71 100644 --- a/frontend/checksupport.icl +++ b/frontend/checksupport.icl @@ -199,7 +199,7 @@ class envLookUp a :: !a !(Env Ident .b) -> (!Bool,.b) instance envLookUp TypeVar where envLookUp var [bind:binds] - | var.tv_name == bind.bind_src + | var.tv_ident == bind.bind_src = (True, bind.bind_dst) = envLookUp var binds envLookUp var [] @@ -208,7 +208,7 @@ where instance envLookUp AttributeVar where envLookUp var [bind:binds] - | var.av_name == bind.bind_src + | var.av_ident == bind.bind_src = (True, bind.bind_dst) = envLookUp var binds envLookUp var [] @@ -217,7 +217,7 @@ where instance envLookUp ATypeVar where envLookUp var=:{atv_variable} [bind:binds] - | atv_variable.tv_name == bind.bind_src + | atv_variable.tv_ident == bind.bind_src = (True, bind.bind_dst) = envLookUp var binds envLookUp var [] @@ -323,7 +323,7 @@ addLocalFunctionDefsToSymbolTable level from_index to_index is_macro_fun fun_def | from_index == to_index = (fun_defs, symbol_table, error) # (fun_def, fun_defs) = fun_defs![from_index] - # (symbol_table, error) = addDefToSymbolTable level from_index fun_def.fun_symb (STE_FunctionOrMacro []) symbol_table error + # (symbol_table, error) = addDefToSymbolTable level from_index fun_def.fun_ident (STE_FunctionOrMacro []) symbol_table error | is_macro_fun # fun_defs = {fun_defs & [from_index].fun_info.fi_properties = fun_def.fun_info.fi_properties bitor FI_IsMacroFun } = addLocalFunctionDefsToSymbolTable level (inc from_index) to_index is_macro_fun fun_defs symbol_table error @@ -334,7 +334,7 @@ addLocalDclMacroDefsToSymbolTable level module_index from_index to_index macro_d | from_index == to_index = (macro_defs, symbol_table, error) # (macro_def, macro_defs) = macro_defs![module_index,from_index] - # (symbol_table, error) = addDefToSymbolTable level from_index macro_def.fun_symb (STE_DclMacroOrLocalMacroFunction []) symbol_table error + # (symbol_table, error) = addDefToSymbolTable level from_index macro_def.fun_ident (STE_DclMacroOrLocalMacroFunction []) symbol_table error # macro_defs = {macro_defs & [module_index].[from_index].fun_info.fi_properties = macro_def.fun_info.fi_properties bitor FI_IsMacroFun } = addLocalDclMacroDefsToSymbolTable level module_index (inc from_index) to_index macro_defs symbol_table error @@ -574,23 +574,23 @@ class toIdent a :: !a -> Ident instance toIdent SymbIdent where - toIdent symb = symb.symb_name + toIdent symb = symb.symb_ident instance toIdent TypeSymbIdent where - toIdent type_symb = type_symb.type_name + toIdent type_symb = type_symb.type_ident instance toIdent BoundVar where - toIdent var = var.var_name + toIdent var = var.var_ident instance toIdent TypeVar where - toIdent tvar = tvar.tv_name + toIdent tvar = tvar.tv_ident instance toIdent ATypeVar where - toIdent {atv_variable} = atv_variable.tv_name + toIdent {atv_variable} = atv_variable.tv_ident instance toIdent Ident @@ -599,27 +599,27 @@ where instance toIdent ConsDef where - toIdent cons = cons.cons_symb + toIdent cons = cons.cons_ident instance toIdent (TypeDef a) where - toIdent td = td.td_name + toIdent td = td.td_ident instance toIdent ClassDef where - toIdent cl = cl.class_name + toIdent cl = cl.class_ident instance toIdent MemberDef where - toIdent me = me.me_symb + toIdent me = me.me_ident instance toIdent FunDef where - toIdent fun = fun.fun_symb + toIdent fun = fun.fun_ident instance toIdent SelectorDef where - toIdent sd = sd.sd_symb + toIdent sd = sd.sd__ident /* instance toIdent DeltaRule diff --git a/frontend/checktypes.icl b/frontend/checktypes.icl index 7ee610c..c19d55a 100644 --- a/frontend/checktypes.icl +++ b/frontend/checktypes.icl @@ -56,7 +56,7 @@ where try_to_combine_attributes TA_Multi _ = True try_to_combine_attributes (TA_Var attr_var1) (TA_Var attr_var2) - = attr_var1.av_name == attr_var2.av_name + = attr_var1.av_ident == attr_var2.av_ident try_to_combine_attributes TA_Unique TA_Unique = True try_to_combine_attributes TA_Unique TA_Multi @@ -78,7 +78,7 @@ where instance bindTypes TypeVar where - bindTypes cti tv=:{tv_name=var_id=:{id_info}} (ts, ti, cs=:{cs_symbol_table}) + bindTypes cti tv=:{tv_ident=var_id=:{id_info}} (ts, ti, cs=:{cs_symbol_table}) # (var_def, cs_symbol_table) = readPtr id_info cs_symbol_table cs = { cs & cs_symbol_table = cs_symbol_table } = case var_def.ste_kind of @@ -121,7 +121,7 @@ where bindTypes cti (TV tv) ts_ti_cs # (tv, attr, ts_ti_cs) = bindTypes cti tv ts_ti_cs = (TV tv, attr, ts_ti_cs) - bindTypes cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} type=:(TA type_cons=:{type_name=type_name=:{id_info}} types) + bindTypes cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} type=:(TA type_cons=:{type_ident=type_ident=:{id_info}} types) (ts=:{ts_type_defs,ts_modules}, ti, cs=:{cs_symbol_table}) # ((type_index, type_module), cs_symbol_table, ti_used_types) = retrieveTypeDefinition id_info cti_module_index cs_symbol_table ti.ti_used_types ti = { ti & ti_used_types = ti_used_types } @@ -135,9 +135,9 @@ where = (TA { type_cons & type_index = { glob_object = type_index, glob_module = type_module}} types, cti_lhs_attribute, ts_ti_cs) = (TA { type_cons & type_index = { glob_object = type_index, glob_module = type_module}} types, determine_type_attribute td_attribute, ts_ti_cs) - = (TE, TA_Multi, (ts, ti, { cs & cs_error = checkError type_cons.type_name "used with wrong arity" cs.cs_error })) - = (TE, TA_Multi, (ts, ti, { cs & cs_error = checkError type_cons.type_name "undefined" cs.cs_error})) - bindTypes cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} type=:(TAS type_cons=:{type_name=type_name=:{id_info}} types strictness) + = (TE, TA_Multi, (ts, ti, { cs & cs_error = checkError type_cons.type_ident "used with wrong arity" cs.cs_error })) + = (TE, TA_Multi, (ts, ti, { cs & cs_error = checkError type_cons.type_ident "undefined" cs.cs_error})) + bindTypes cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} type=:(TAS type_cons=:{type_ident=type_ident=:{id_info}} types strictness) (ts=:{ts_type_defs,ts_modules}, ti, cs=:{cs_symbol_table}) # ((type_index, type_module), cs_symbol_table, ti_used_types) = retrieveTypeDefinition id_info cti_module_index cs_symbol_table ti.ti_used_types ti = { ti & ti_used_types = ti_used_types } @@ -151,8 +151,8 @@ where = (TAS { type_cons & type_index = { glob_object = type_index, glob_module = type_module}} types strictness, cti_lhs_attribute, ts_ti_cs) = (TAS { type_cons & type_index = { glob_object = type_index, glob_module = type_module}} types strictness, determine_type_attribute td_attribute, ts_ti_cs) - = (TE, TA_Multi, (ts, ti, { cs & cs_error = checkError type_cons.type_name "used with wrong arity" cs.cs_error })) - = (TE, TA_Multi, (ts, ti, { cs & cs_error = checkError type_cons.type_name "undefined" cs.cs_error})) + = (TE, TA_Multi, (ts, ti, { cs & cs_error = checkError type_cons.type_ident "used with wrong arity" cs.cs_error })) + = (TE, TA_Multi, (ts, ti, { cs & cs_error = checkError type_cons.type_ident "undefined" cs.cs_error})) bindTypes cti (arg_type --> res_type) ts_ti_cs # (arg_type, _, ts_ti_cs) = bindTypes cti arg_type ts_ti_cs (res_type, _, ts_ti_cs) = bindTypes cti res_type ts_ti_cs @@ -198,11 +198,11 @@ emptyIdent name :== { id_name = name, id_info = nilPtr } checkTypeDef :: !Index !Index !*TypeSymbols !*TypeInfo !*CheckState -> (!*TypeSymbols, !*TypeInfo, !*CheckState); checkTypeDef type_index module_index ts=:{ts_type_defs} ti=:{ti_type_heaps} cs=:{cs_error} # (type_def, ts_type_defs) = ts_type_defs![type_index] - # {td_name,td_pos,td_args,td_attribute,td_index} = type_def + # {td_ident,td_pos,td_args,td_attribute,td_index} = type_def | td_index == NoIndex - # position = newPosition td_name td_pos + # position = newPosition td_ident td_pos cs_error = pushErrorAdmin position cs_error - (td_attribute, attr_vars, th_attrs) = determine_root_attribute td_attribute td_name.id_name ti_type_heaps.th_attrs + (td_attribute, attr_vars, th_attrs) = determine_root_attribute td_attribute td_ident.id_name ti_type_heaps.th_attrs (type_vars, (attr_vars, ti_type_heaps, cs)) = addTypeVariablesToSymbolTable cGlobalScope td_args attr_vars { ti_type_heaps & th_attrs = th_attrs } { cs & cs_error = cs_error } type_def = { type_def & td_args = type_vars, td_index = type_index, td_attrs = attr_vars, td_attribute = td_attribute } @@ -217,7 +217,7 @@ checkTypeDef type_index module_index ts=:{ts_type_defs} ti=:{ti_type_heaps} cs=: where determine_root_attribute TA_None name attr_var_heap # (attr_info_ptr, attr_var_heap) = newPtr AVI_Empty attr_var_heap - new_var = { av_name = emptyIdent name, av_info_ptr = attr_info_ptr} + new_var = { av_ident = emptyIdent name, av_info_ptr = attr_info_ptr} = (TA_Var new_var, [new_var], attr_var_heap) determine_root_attribute TA_Unique name attr_var_heap = (TA_Unique, [], attr_var_heap) @@ -226,16 +226,16 @@ where check_rhs_of_TypeDef :: !CheckedTypeDef ![AttributeVar] !CurrentTypeInfo !(!*TypeSymbols, !*TypeInfo, !*CheckState) -> (!TypeRhs, !(!*TypeSymbols, !*TypeInfo, !*CheckState)) // - check_rhs_of_TypeDef {td_name,td_arity,td_args,td_rhs = td_rhs=:AlgType conses} attr_vars cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} ts_ti_cs + check_rhs_of_TypeDef {td_ident,td_arity,td_args,td_rhs = td_rhs=:AlgType conses} attr_vars cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} ts_ti_cs # type_lhs = { at_attribute = cti_lhs_attribute, - at_type = TA (MakeTypeSymbIdent { glob_object = cti_type_index, glob_module = cti_module_index } td_name td_arity) + at_type = TA (MakeTypeSymbIdent { glob_object = cti_type_index, glob_module = cti_module_index } td_ident td_arity) [{at_attribute = atv_attribute,at_type = TV atv_variable} \\ {atv_variable, atv_attribute} <- td_args]} ts_ti_cs = bind_types_of_constructors cti 0 [ atv_variable \\ {atv_variable} <- td_args] attr_vars type_lhs conses ts_ti_cs = (td_rhs, ts_ti_cs) - check_rhs_of_TypeDef {td_name,td_arity,td_args,td_rhs = td_rhs=:RecordType {rt_constructor=rec_cons=:{ds_index}, rt_fields}} + check_rhs_of_TypeDef {td_ident,td_arity,td_args,td_rhs = td_rhs=:RecordType {rt_constructor=rec_cons=:{ds_index}, rt_fields}} attr_vars cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} ts_ti_cs # type_lhs = { at_attribute = cti_lhs_attribute, - at_type = TA (MakeTypeSymbIdent { glob_object = cti_type_index, glob_module = cti_module_index } td_name td_arity) + at_type = TA (MakeTypeSymbIdent { glob_object = cti_type_index, glob_module = cti_module_index } td_ident td_arity) [{ at_attribute = atv_attribute,at_type = TV atv_variable} \\ {atv_variable, atv_attribute} <- td_args]} (ts, ti, cs) = bind_types_of_constructors cti 0 [ atv_variable \\ {atv_variable} <- td_args] attr_vars type_lhs [rec_cons] ts_ti_cs @@ -303,7 +303,7 @@ where = ({ ts & ts_cons_defs = { ts.ts_cons_defs & [ds_index] = { cons_def & cons_type = cons_type, cons_index = cons_index, cons_type_index = cti.cti_type_index, cons_exi_vars = exi_vars, cons_type_ptr = new_type_ptr, cons_arg_vars = cons_arg_vars }}}, { ti & ti_var_heap = ti_var_heap }, cs) -// ---> ("bind_types_of_constructors", cons_def.cons_symb, exi_vars, cons_type) +// ---> ("bind_types_of_constructors", cons_def.cons_ident, exi_vars, cons_type) where bind_types_of_cons :: ![AType] !CurrentTypeInfo ![TypeVar] ![AttrInequality] !(!*TypeSymbols, !*TypeInfo, !*CheckState) -> (![AType], ![[ATypeVar]], ![AttrInequality], !(!*TypeSymbols, !*TypeInfo, !*CheckState)) @@ -317,7 +317,7 @@ where (attr_env, cs_error) = addToAttributeEnviron type_attr cti.cti_lhs_attribute attr_env cs.cs_error = ([type : types], [local_vars : local_vars_list], attr_env, (ts, ti , { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error })) where - retrieve_local_vars tv=:{tv_name={id_info}} (local_vars, symbol_table) + retrieve_local_vars tv=:{tv_ident={id_info}} (local_vars, symbol_table) # (ste=:{ste_kind = STE_BoundTypeVariable bv=:{stv_attribute, stv_info_ptr, stv_count }}, symbol_table) = readPtr id_info symbol_table | stv_count == 0 = (local_vars, symbol_table) @@ -368,7 +368,7 @@ where , ots_modules :: .{# DclModule} } -determineAttributeVariable attr_var=:{av_name=attr_name=:{id_info}} oti=:{oti_heaps,oti_all_attrs} symbol_table +determineAttributeVariable attr_var=:{av_ident=attr_name=:{id_info}} oti=:{oti_heaps,oti_all_attrs} symbol_table # (entry=:{ste_kind,ste_def_level}, symbol_table) = readPtr id_info symbol_table | ste_kind == STE_Empty || ste_def_level == cModuleScope #! (new_attr_ptr, th_attrs) = newPtr AVI_Empty oti_heaps.th_attrs @@ -387,15 +387,15 @@ instance toString DemandedAttributeKind where newAttribute :: !DemandedAttributeKind {#Char} TypeAttribute !*OpenTypeInfo !*CheckState -> (!TypeAttribute, !*OpenTypeInfo, !*CheckState) -newAttribute DAK_Ignore var_name attr oti cs +newAttribute DAK_Ignore var_ident attr oti cs = case attr of TA_Multi -> (TA_Multi, oti, cs) TA_None -> (TA_Multi, oti, cs) _ - -> (TA_Multi, oti, { cs & cs_error = checkError var_name "attribute not allowed" cs.cs_error }) -newAttribute DAK_Unique var_name new_attr oti cs + -> (TA_Multi, oti, { cs & cs_error = checkError var_ident "attribute not allowed" cs.cs_error }) +newAttribute DAK_Unique var_ident new_attr oti cs = case new_attr of TA_Unique -> (TA_Unique, oti, cs) @@ -404,17 +404,17 @@ newAttribute DAK_Unique var_name new_attr oti cs TA_None -> (TA_Unique, oti, cs) _ - -> (TA_Unique, oti, { cs & cs_error = checkError var_name "inconsistently attributed (2)" cs.cs_error }) -newAttribute DAK_None var_name (TA_Var attr_var) oti cs=:{cs_symbol_table} + -> (TA_Unique, oti, { cs & cs_error = checkError var_ident "inconsistently attributed (2)" cs.cs_error }) +newAttribute DAK_None var_ident (TA_Var attr_var) oti cs=:{cs_symbol_table} # (attr_var, oti, cs_symbol_table) = determineAttributeVariable attr_var oti cs_symbol_table = (TA_Var attr_var, oti, { cs & cs_symbol_table = cs_symbol_table }) -newAttribute DAK_None var_name TA_Anonymous oti=:{oti_heaps, oti_all_attrs} cs +newAttribute DAK_None var_ident TA_Anonymous oti=:{oti_heaps, oti_all_attrs} cs # (new_attr_ptr, th_attrs) = newPtr AVI_Empty oti_heaps.th_attrs - new_attr = { av_info_ptr = new_attr_ptr, av_name = emptyIdent var_name } + new_attr = { av_info_ptr = new_attr_ptr, av_ident = emptyIdent var_ident } = (TA_Var new_attr, { oti & oti_heaps = { oti_heaps & th_attrs = th_attrs }, oti_all_attrs = [new_attr : oti_all_attrs] }, cs) -newAttribute DAK_None var_name TA_Unique oti cs +newAttribute DAK_None var_ident TA_Unique oti cs = (TA_Unique, oti, cs) -newAttribute DAK_None var_name attr oti cs +newAttribute DAK_None var_ident attr oti cs = (TA_Multi, oti, cs) @@ -458,7 +458,7 @@ getGenericDef generic_index type_module module_index generic_defs modules checkTypeVar :: !Level !DemandedAttributeKind !TypeVar !TypeAttribute !(!*OpenTypeInfo, !*CheckState) -> (! TypeVar, !TypeAttribute, !(!*OpenTypeInfo, !*CheckState)) -checkTypeVar scope dem_attr tv=:{tv_name=var_name=:{id_name,id_info}} tv_attr (oti, cs=:{cs_symbol_table}) +checkTypeVar scope dem_attr tv=:{tv_ident=var_ident=:{id_name,id_info}} tv_attr (oti, cs=:{cs_symbol_table}) # (entry=:{ste_kind,ste_def_level},cs_symbol_table) = readPtr id_info cs_symbol_table | ste_kind == STE_Empty || ste_def_level == cModuleScope # (new_attr, oti=:{oti_heaps,oti_all_vars}, cs) = newAttribute dem_attr id_name tv_attr oti { cs & cs_symbol_table = cs_symbol_table } @@ -480,10 +480,10 @@ where incr_ref_count tv_info_ptr _ th_vars = th_vars - check_attribute var_name DAK_Ignore (TVI_AttrAndRefCount prev_attr ref_count) this_attr oti cs=:{cs_error} + check_attribute var_ident DAK_Ignore (TVI_AttrAndRefCount prev_attr ref_count) this_attr oti cs=:{cs_error} = (TA_Multi, oti, cs) - check_attribute var_name dem_attr (TVI_AttrAndRefCount prev_attr ref_count) this_attr oti cs=:{cs_error} - # (new_attr, cs_error) = determine_attribute var_name dem_attr this_attr cs_error + check_attribute var_ident dem_attr (TVI_AttrAndRefCount prev_attr ref_count) this_attr oti cs=:{cs_error} + # (new_attr, cs_error) = determine_attribute var_ident dem_attr this_attr cs_error = check_var_attribute prev_attr new_attr oti { cs & cs_error = cs_error } where check_var_attribute (TA_Var old_var) (TA_Var new_var) oti cs=:{cs_symbol_table,cs_error} @@ -491,7 +491,7 @@ where | old_var.av_info_ptr == new_var.av_info_ptr = (TA_Var old_var, oti, { cs & cs_symbol_table = cs_symbol_table }) = (TA_Var old_var, oti, { cs & cs_symbol_table = cs_symbol_table, - cs_error = checkError new_var.av_name "inconsistently attributed (3)" cs_error }) + cs_error = checkError new_var.av_ident "inconsistently attributed (3)" cs_error }) check_var_attribute var_attr=:(TA_Var old_var) TA_Anonymous oti cs = (var_attr, oti, cs) check_var_attribute TA_Unique new_attr oti cs @@ -499,7 +499,7 @@ where TA_Unique -> (TA_Unique, oti, cs) _ - -> (TA_Unique, oti, { cs & cs_error = checkError var_name "inconsistently attributed (4)" cs.cs_error }) + -> (TA_Unique, oti, { cs & cs_error = checkError var_ident "inconsistently attributed (4)" cs.cs_error }) check_var_attribute TA_Multi new_attr oti cs = case new_attr of TA_Multi @@ -507,12 +507,12 @@ where TA_None -> (TA_Multi, oti, cs) _ - -> (TA_Multi, oti, { cs & cs_error = checkError var_name "inconsistently attributed (5)" cs.cs_error }) + -> (TA_Multi, oti, { cs & cs_error = checkError var_ident "inconsistently attributed (5)" cs.cs_error }) check_var_attribute var_attr new_attr oti cs - = (var_attr, oti, { cs & cs_error = checkError var_name "inconsistently attributed (6)" cs.cs_error })// ---> (var_attr, new_attr) + = (var_attr, oti, { cs & cs_error = checkError var_ident "inconsistently attributed (6)" cs.cs_error })// ---> (var_attr, new_attr) - determine_attribute var_name DAK_Unique new_attr error + determine_attribute var_ident DAK_Unique new_attr error = case new_attr of TA_Multi -> (TA_Unique, error) @@ -521,13 +521,13 @@ where TA_Unique -> (TA_Unique, error) _ - -> (TA_Unique, checkError var_name "inconsistently attributed (1)" error) - determine_attribute var_name dem_attr TA_None error + -> (TA_Unique, checkError var_ident "inconsistently attributed (1)" error) + determine_attribute var_ident dem_attr TA_None error = (TA_Multi, error) - determine_attribute var_name dem_attr new_attr error + determine_attribute var_ident dem_attr new_attr error = (new_attr, error) - check_attribute var_name dem_attr _ this_attr oti cs + check_attribute var_ident dem_attr _ this_attr oti cs = (TA_Multi, oti, cs) check_args_of_type_cons :: !Index !Int !DemandedAttributeKind ![AType] ![ATypeVar] !(!u:OpenTypeSymbols, !*OpenTypeInfo, !*CheckState) @@ -551,7 +551,7 @@ checkOpenAType :: !Index !Int !DemandedAttributeKind !AType !(!u:OpenTypeSymbols checkOpenAType mod_index scope dem_attr type=:{at_type = TV tv, at_attribute} (ots, oti, cs) # (tv, at_attribute, (oti, cs)) = checkTypeVar scope dem_attr tv at_attribute (oti, cs) = ({ type & at_type = TV tv, at_attribute = at_attribute }, (ots, oti, cs)) -checkOpenAType mod_index scope dem_attr type=:{at_type = GTV var_id=:{tv_name={id_info}}} (ots, oti=:{oti_heaps,oti_global_vars}, cs=:{cs_symbol_table}) +checkOpenAType mod_index scope dem_attr type=:{at_type = GTV var_id=:{tv_ident={id_info}}} (ots, oti=:{oti_heaps,oti_global_vars}, cs=:{cs_symbol_table}) # (entry, cs_symbol_table) = readPtr id_info cs_symbol_table (type_var, oti_global_vars, th_vars, entry) = retrieve_global_variable var_id entry oti_global_vars oti_heaps.th_vars = ({type & at_type = TV type_var, at_attribute = TA_Multi }, (ots, { oti & oti_heaps = { oti_heaps & th_vars = th_vars }, oti_global_vars = oti_global_vars }, @@ -576,7 +576,7 @@ where # (var, global_vars, var_heap, ste_previous) = retrieve_global_variable var ste_previous global_vars var_heap = (var, global_vars, var_heap, { entry & ste_previous = ste_previous }) // -checkOpenAType mod_index scope dem_attr_kind type=:{ at_type=TA type_cons=:{type_name=type_name=:{id_name,id_info}} types, at_attribute} +checkOpenAType mod_index scope dem_attr_kind type=:{ at_type=TA type_cons=:{type_ident=type_ident=:{id_name,id_info}} types, at_attribute} (ots=:{ots_type_defs,ots_modules}, oti, cs=:{cs_symbol_table,cs_x={x_check_dynamic_types}}) # (entry, cs_symbol_table) = readPtr id_info cs_symbol_table cs = { cs & cs_symbol_table = cs_symbol_table } @@ -585,16 +585,16 @@ checkOpenAType mod_index scope dem_attr_kind type=:{ at_type=TA type_cons=:{type # ({td_arity,td_args,td_attribute,td_rhs},type_index,ots_type_defs,ots_modules) = getTypeDef type_index type_module mod_index ots_type_defs ots_modules ots = { ots & ots_type_defs = ots_type_defs, ots_modules = ots_modules } | x_check_dynamic_types && checkAbstractType type_module td_rhs - = (type, (ots, oti, {cs & cs_error = checkError type_name "(abstract type) not permitted in a dynamic type" cs.cs_error})) + = (type, (ots, oti, {cs & cs_error = checkError type_ident "(abstract type) not permitted in a dynamic type" cs.cs_error})) | checkArityOfType type_cons.type_arity td_arity td_rhs # type_cons = { type_cons & type_index = { glob_object = type_index, glob_module = type_module }} (types, (ots, oti, cs)) = check_args_of_type_cons mod_index scope dem_attr_kind types td_args (ots, oti, cs) (new_attr, oti, cs) = newAttribute (new_demanded_attribute dem_attr_kind td_attribute) id_name at_attribute oti cs = ({ type & at_type = TA type_cons types, at_attribute = new_attr } , (ots, oti, cs)) - = (type, (ots, oti, {cs & cs_error = checkError type_name "used with wrong arity" cs.cs_error})) - = (type, (ots, oti, {cs & cs_error = checkError type_name "undefined" cs.cs_error})) -checkOpenAType mod_index scope dem_attr type=:{ at_type=TAS type_cons=:{type_name=type_name=:{id_name,id_info}} types strictness, at_attribute} + = (type, (ots, oti, {cs & cs_error = checkError type_ident "used with wrong arity" cs.cs_error})) + = (type, (ots, oti, {cs & cs_error = checkError type_ident "undefined" cs.cs_error})) +checkOpenAType mod_index scope dem_attr type=:{ at_type=TAS type_cons=:{type_ident=type_ident=:{id_name,id_info}} types strictness, at_attribute} (ots=:{ots_type_defs,ots_modules}, oti, cs=:{cs_symbol_table}) # (entry, cs_symbol_table) = readPtr id_info cs_symbol_table cs = { cs & cs_symbol_table = cs_symbol_table } @@ -607,8 +607,8 @@ checkOpenAType mod_index scope dem_attr type=:{ at_type=TAS type_cons=:{type_nam (types, (ots, oti, cs)) = check_args_of_type_cons mod_index scope dem_attr types td_args (ots, oti, cs) (new_attr, oti, cs) = newAttribute (new_demanded_attribute dem_attr td_attribute) id_name at_attribute oti cs = ({ type & at_type = TAS type_cons types strictness, at_attribute = new_attr} , (ots, oti, cs)) - = (type, (ots, oti, {cs & cs_error = checkError type_name "used with wrong arity" cs.cs_error})) - = (type, (ots, oti, {cs & cs_error = checkError type_name "undefined" cs.cs_error})) + = (type, (ots, oti, {cs & cs_error = checkError type_ident "used with wrong arity" cs.cs_error})) + = (type, (ots, oti, {cs & cs_error = checkError type_ident "undefined" cs.cs_error})) checkOpenAType mod_index scope dem_attr type=:{at_type = arg_type --> result_type, at_attribute} cot_state # (arg_type, cot_state) = checkOpenAType mod_index scope DAK_None arg_type cot_state (result_type, (ots, oti, cs)) = checkOpenAType mod_index scope DAK_None result_type cot_state @@ -637,7 +637,7 @@ checkOpenAType mod_index scope dem_attr atype=:{at_type = TFA vars type, at_attr cs = { cs & cs_symbol_table = foldSt remove_universal_var vars cs.cs_symbol_table } = ( { checked_type & at_type = TFA vars checked_type.at_type }, (ots, oti, cs)) where - add_universal_var atv=:{atv_variable = tv=:{tv_name={id_name,id_info}}, atv_attribute} (oti, cs=:{cs_symbol_table,cs_error}) + add_universal_var atv=:{atv_variable = tv=:{tv_ident={id_name,id_info}}, atv_attribute} (oti, cs=:{cs_symbol_table,cs_error}) # (entry=:{ste_kind,ste_def_level},cs_symbol_table) = readPtr id_info cs_symbol_table | ste_kind == STE_Empty || ste_def_level < cRankTwoScope # (new_attr, oti=:{oti_heaps}, cs) = newAttribute DAK_None id_name atv_attribute oti { cs & cs_symbol_table = cs_symbol_table } @@ -648,10 +648,10 @@ where ste_def_level = cRankTwoScope, ste_previous = entry })})) = (atv, (oti, { cs & cs_error = checkError id_name "type variable already undefined" cs_error, cs_symbol_table = cs_symbol_table })) - remove_universal_var {atv_variable = {tv_name}, atv_attribute = TA_Var {av_name}} cs_symbol_table - = removeDefinitionFromSymbolTable cGlobalScope av_name (removeDefinitionFromSymbolTable cRankTwoScope tv_name cs_symbol_table) - remove_universal_var {atv_variable = {tv_name}} cs_symbol_table - = removeDefinitionFromSymbolTable cRankTwoScope tv_name cs_symbol_table + remove_universal_var {atv_variable = {tv_ident}, atv_attribute = TA_Var {av_ident}} cs_symbol_table + = removeDefinitionFromSymbolTable cGlobalScope av_ident (removeDefinitionFromSymbolTable cRankTwoScope tv_ident cs_symbol_table) + remove_universal_var {atv_variable = {tv_ident}} cs_symbol_table + = removeDefinitionFromSymbolTable cRankTwoScope tv_ident cs_symbol_table checkOpenAType mod_index scope dem_attr type=:{at_attribute} (ots, oti, cs) # (new_attr, oti, cs) = newAttribute dem_attr "." at_attribute oti cs @@ -699,10 +699,10 @@ checkInstanceType mod_index ins_class it=:{it_types,it_context} specials type_de # (th_vars, cs_error) = foldSt check_linearity vars (th_vars, cs_error) = ({heaps & th_vars = th_vars}, {cs & cs_error = cs_error}) where - check_linearity {tv_name, tv_info_ptr} (th_vars, error) + check_linearity {tv_ident, tv_info_ptr} (th_vars, error) # (TVI_AttrAndRefCount prev_attr ref_count, th_vars) = readPtr tv_info_ptr th_vars | ref_count > 1 - = (th_vars, checkError tv_name ": this type variable occurs more than once in an instance type" error) + = (th_vars, checkError tv_ident ": this type variable occurs more than once in an instance type" error) = (th_vars, error) @@ -776,7 +776,7 @@ checkSymbolType is_function mod_index st=:{st_args,st_result,st_context,st_attr_ = (checked_st, specials, type_defs, class_defs, modules, heaps, cs) // ---> ("checkSymbolType", checked_st) where - check_attr_inequality ineq=:{ai_demanded=ai_demanded=:{av_name=dem_name},ai_offered=ai_offered=:{av_name=off_name}} cs=:{cs_symbol_table,cs_error} + check_attr_inequality ineq=:{ai_demanded=ai_demanded=:{av_ident=dem_name},ai_offered=ai_offered=:{av_ident=off_name}} cs=:{cs_symbol_table,cs_error} # (dem_entry, cs_symbol_table) = readPtr dem_name.id_info cs_symbol_table # (found_dem_attr, dem_attr_ptr) = retrieve_attribute dem_entry | found_dem_attr @@ -827,7 +827,7 @@ checkSuperClasses class_args class_contexts mod_index type_defs class_defs modul where add_variable_to_symbol_table :: !TypeVar !(![TypeVar], !*SymbolTable, !*TypeVarHeap, !*ErrorAdmin) -> (![TypeVar],!*SymbolTable,!*TypeVarHeap,!*ErrorAdmin) - add_variable_to_symbol_table tv=:{tv_name={id_name,id_info}} (rev_class_args, symbol_table, th_vars, error) + add_variable_to_symbol_table tv=:{tv_ident={id_name,id_info}} (rev_class_args, symbol_table, th_vars, error) # (entry, symbol_table) = readPtr id_info symbol_table | entry.ste_kind == STE_Empty || entry.ste_def_level < cGlobalScope # (new_var_ptr, th_vars) = newPtr TVI_Empty th_vars @@ -836,7 +836,7 @@ where = (rev_class_args, symbol_table, th_vars, checkError id_name "(variable) already defined" error) retrieve_variables_from_symbol_table :: ![TypeVar] ![TypeVar] !*SymbolTable -> (![TypeVar],!*SymbolTable) - retrieve_variables_from_symbol_table [var=:{tv_name={id_name,id_info}} : vars] class_args symbol_table + retrieve_variables_from_symbol_table [var=:{tv_ident={id_name,id_info}} : vars] class_args symbol_table # (entry, symbol_table) = readPtr id_info symbol_table = retrieve_variables_from_symbol_table vars [var : class_args] (symbol_table <:= (id_info,entry.ste_previous)) retrieve_variables_from_symbol_table [] class_args symbol_table @@ -872,13 +872,13 @@ where # cs_error = checkError cl.glob_object.ds_ident "class undefined" cs.cs_error = (TCClass cl, (class_defs, ots, {cs & cs_error = cs_error})) check_context_class (TCGeneric gtc=:{gtc_generic, gtc_kind}) (class_defs, ots, cs) - # gen_name = gtc_generic.glob_object.ds_ident - # (entry, cs_symbol_table) = readPtr gen_name.id_info cs.cs_symbol_table + # gen_ident = gtc_generic.glob_object.ds_ident + # (entry, cs_symbol_table) = readPtr gen_ident.id_info cs.cs_symbol_table # cs = { cs & cs_symbol_table = cs_symbol_table } # clazz = { glob_module = -1 , glob_object = - { ds_ident = genericIdentToClassIdent gen_name gtc_kind + { ds_ident = genericIdentToClassIdent gen_ident gtc_kind , ds_arity = 1 , ds_index = -1 } @@ -892,16 +892,16 @@ where , glob_object = {gtc_generic.glob_object & ds_index = generic_index} } = (TCGeneric {gtc & gtc_generic = checked_gen, gtc_class=clazz}, (class_defs, ots, cs)) - # cs_error = checkError gen_name "generic used with wrong arity: generic has always has one class argument" cs.cs_error + # cs_error = checkError gen_ident "generic used with wrong arity: generic has always has one class argument" cs.cs_error = (TCGeneric {gtc & gtc_class=clazz}, (class_defs, ots, {cs & cs_error = cs_error})) - # cs_error = checkError gen_name "generic undefined" cs.cs_error + # cs_error = checkError gen_ident "generic undefined" cs.cs_error = (TCGeneric {gtc & gtc_class=clazz}, (class_defs, ots, {cs & cs_error = cs_error})) check_context_types tc_class [] cs=:{cs_error} = { cs & cs_error = checkError tc_class "type context should contain one or more type variables" cs_error} - check_context_types tc_class [((CV {tv_name}) :@: _):_] cs=:{cs_error} + check_context_types tc_class [((CV {tv_ident}) :@: _):_] cs=:{cs_error} = cs -// = { cs & cs_error = checkError tv_name "not allowed as higher order type variable in context" cs_error} +// = { cs & cs_error = checkError tv_ident "not allowed as higher order type variable in context" cs_error} check_context_types tc_class [TV _ : types] cs = cs check_context_types tc_class [type : types] cs @@ -919,16 +919,16 @@ where check_class_variables class_variables cs = foldSt check_class_variable class_variables cs where - check_class_variable {tv_name} cs=:{cs_symbol_table,cs_error} - = { cs & cs_symbol_table = removeDefinitionFromSymbolTable cGlobalScope tv_name cs_symbol_table, - cs_error = checkError tv_name "wrongly used or not used at all" cs_error} + check_class_variable {tv_ident} cs=:{cs_symbol_table,cs_error} + = { cs & cs_symbol_table = removeDefinitionFromSymbolTable cGlobalScope tv_ident cs_symbol_table, + cs_error = checkError tv_ident "wrongly used or not used at all" cs_error} check_class_attributes class_attributes cs = foldSt check_class_attribute class_attributes cs where - check_class_attribute {av_name} cs=:{cs_symbol_table,cs_error} - = { cs & cs_symbol_table = removeDefinitionFromSymbolTable cGlobalScope av_name cs_symbol_table, - cs_error = checkError av_name "undefined" cs_error} + check_class_attribute {av_ident} cs=:{cs_symbol_table,cs_error} + = { cs & cs_symbol_table = removeDefinitionFromSymbolTable cGlobalScope av_ident cs_symbol_table, + cs_error = checkError av_ident "undefined" cs_error} checkDynamicTypes :: !Index ![ExprInfoPtr] !(Optional SymbolType) !u:{# CheckedTypeDef} !u:{# DclModule} !*TypeHeaps !*ExpressionHeap !*CheckState @@ -955,7 +955,7 @@ where remove_global_type_variables global_vars symbol_table = foldSt remove_global_type_variable global_vars symbol_table where - remove_global_type_variable {tv_name=tv_name=:{id_info}} symbol_table + remove_global_type_variable {tv_ident=tv_ident=:{id_info}} symbol_table # (entry, symbol_table) = readPtr id_info symbol_table | entry.ste_kind == STE_Empty = symbol_table @@ -971,7 +971,7 @@ checkDynamicTypes mod_index dyn_type_ptrs (Yes {st_vars}) type_defs modules type (expr_heap, cs) = check_global_type_variables_in_dynamics dyn_type_ptrs (expr_heap, { cs & cs_symbol_table = cs_symbol_table }) = (type_defs, modules, heaps, expr_heap, cs) where - add_type_variable_to_symbol_table {tv_name={id_info},tv_info_ptr} (var_heap,symbol_table) + add_type_variable_to_symbol_table {tv_ident={id_info},tv_info_ptr} (var_heap,symbol_table) # (entry, symbol_table) = readPtr id_info symbol_table = ( var_heap <:= (tv_info_ptr, TVI_Empty), symbol_table <:= (id_info, {ste_index = NoIndex, ste_kind = STE_TypeVariable tv_info_ptr, @@ -994,12 +994,12 @@ where check_global_type_variables global_vars cs = foldSt check_global_type_variable global_vars cs where - check_global_type_variable {tv_name=tv_name=:{id_info}} cs=:{cs_symbol_table, cs_error} + check_global_type_variable {tv_ident=tv_ident=:{id_info}} cs=:{cs_symbol_table, cs_error} # (entry, cs_symbol_table) = readPtr id_info cs_symbol_table | entry.ste_kind == STE_Empty = { cs & cs_symbol_table = cs_symbol_table } = { cs & cs_symbol_table = cs_symbol_table <:= (id_info, entry.ste_previous), - cs_error = checkError tv_name.id_name "global type variable not used in type of the function" cs_error } + cs_error = checkError tv_ident.id_name "global type variable not used in type of the function" cs_error } checkDynamics mod_index scope dyn_type_ptrs type_defs modules type_heaps expr_heap cs = foldSt (check_dynamic mod_index scope) dyn_type_ptrs (type_defs, modules, type_heaps, expr_heap, cs) @@ -1046,11 +1046,11 @@ where # cs_symbol_table = removeAttributesFromSymbolTable oti_all_attrs cs_symbol_table = ({ dt & dt_uni_vars = dt_uni_vars, dt_global_vars = oti_global_vars, dt_type = dt_type }, oti_all_vars, ots_type_defs, ots_modules, { oti_heaps & th_vars = th_vars }, - { cs & cs_symbol_table = cs_symbol_table, cs_error = checkError (hd oti_all_attrs).av_name "type attribute variable not allowed" cs.cs_error}) + { cs & cs_symbol_table = cs_symbol_table, cs_error = checkError (hd oti_all_attrs).av_ident "type attribute variable not allowed" cs.cs_error}) add_type_variable_to_symbol_table :: !Level !ATypeVar !*(!*TypeVarHeap,!*CheckState) -> (!ATypeVar,!(!*TypeVarHeap, !*CheckState)) - add_type_variable_to_symbol_table scope atv=:{atv_variable=atv_variable=:{tv_name}, atv_attribute} (type_var_heap, cs=:{cs_symbol_table,cs_error}) - # var_info = tv_name.id_info + add_type_variable_to_symbol_table scope atv=:{atv_variable=atv_variable=:{tv_ident}, atv_attribute} (type_var_heap, cs=:{cs_symbol_table,cs_error}) + # var_info = tv_ident.id_info (var_entry, cs_symbol_table) = readPtr var_info cs_symbol_table | var_entry.ste_kind == STE_Empty || scope < var_entry.ste_def_level #! (new_var_ptr, type_var_heap) = newPtr TVI_Empty type_var_heap @@ -1058,7 +1058,7 @@ where (var_info, {ste_index = NoIndex, ste_kind = STE_TypeVariable new_var_ptr, ste_def_level = scope, ste_previous = var_entry }) = ({atv & atv_attribute = TA_Multi, atv_variable = { atv_variable & tv_info_ptr = new_var_ptr }}, (type_var_heap, { cs & cs_symbol_table = cs_symbol_table, cs_error = check_attribute atv_attribute cs_error})) - = (atv, (type_var_heap, { cs & cs_symbol_table = cs_symbol_table, cs_error = checkError tv_name.id_name "type variable already defined" cs_error })) + = (atv, (type_var_heap, { cs & cs_symbol_table = cs_symbol_table, cs_error = checkError tv_ident.id_name "type variable already defined" cs_error })) check_attribute TA_Unique error = error @@ -1081,7 +1081,7 @@ where # (binds,cs) = check_type_vars binds cs = ([bind:binds],cs) - check_type_var bind=:{bind_dst=type_var=:{tv_name={id_name,id_info}}} binds cs=:{cs_symbol_table,cs_error} + check_type_var bind=:{bind_dst=type_var=:{tv_ident={id_name,id_info}}} binds cs=:{cs_symbol_table,cs_error} # ({ste_kind,ste_def_level}, cs_symbol_table) = readPtr id_info cs_symbol_table | ste_kind <> STE_Empty && ste_def_level == cGlobalScope # (STE_TypeVariable tv_info_ptr) = ste_kind @@ -1091,7 +1091,7 @@ where = (bind, { cs & cs_symbol_table= cs_symbol_table, cs_error = checkError id_name "type variable not used in type" cs_error }) id_info_occurs_in_list id_info [{bind_dst}:l] - = id_info==bind_dst.tv_name.id_info || id_info_occurs_in_list id_info l + = id_info==bind_dst.tv_ident.id_info || id_info_occurs_in_list id_info l id_info_occurs_in_list id_info [] = False checkSpecialTypeVars SP_None cs @@ -1126,21 +1126,21 @@ addTypeVariablesToSymbolTable scope type_vars attr_vars heaps cs where add_type_variable_to_symbol_table :: !Level !ATypeVar !(![AttributeVar], !*TypeHeaps, !*CheckState) -> (!ATypeVar, !(![AttributeVar], !*TypeHeaps, !*CheckState)) - add_type_variable_to_symbol_table scope atv=:{atv_variable=atv_variable=:{tv_name}, atv_attribute} + add_type_variable_to_symbol_table scope atv=:{atv_variable=atv_variable=:{tv_ident}, atv_attribute} (attr_vars, heaps=:{th_vars,th_attrs}, cs=:{ cs_symbol_table, cs_error }) - # tv_info = tv_name.id_info + # tv_info = tv_ident.id_info (entry, cs_symbol_table) = readPtr tv_info cs_symbol_table | entry.ste_def_level < scope // cOuterMostLevel # (tv_info_ptr, th_vars) = newPtr TVI_Empty th_vars atv_variable = { atv_variable & tv_info_ptr = tv_info_ptr } - (atv_attribute, attr_vars, th_attrs, cs_error) = check_attribute (scope == cRankTwoScope) atv_attribute tv_name.id_name attr_vars th_attrs cs_error + (atv_attribute, attr_vars, th_attrs, cs_error) = check_attribute (scope == cRankTwoScope) atv_attribute tv_ident.id_name attr_vars th_attrs cs_error cs_symbol_table = cs_symbol_table <:= (tv_info, {ste_index = NoIndex, ste_kind = STE_BoundTypeVariable {stv_attribute = atv_attribute, stv_info_ptr = tv_info_ptr, stv_count = 0}, ste_def_level = scope /* cOuterMostLevel */, ste_previous = entry }) heaps = { heaps & th_vars = th_vars, th_attrs = th_attrs } = ({atv & atv_variable = atv_variable, atv_attribute = atv_attribute}, (attr_vars, heaps, { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error })) = (atv, (attr_vars, { heaps & th_vars = th_vars }, - { cs & cs_symbol_table = cs_symbol_table, cs_error = checkError tv_name.id_name "type variable already defined" cs_error })) + { cs & cs_symbol_table = cs_symbol_table, cs_error = checkError tv_ident.id_name "type variable already defined" cs_error })) check_attribute :: !Bool !TypeAttribute !String ![AttributeVar] !*AttrVarHeap !*ErrorAdmin -> (!TypeAttribute, ![AttributeVar], !*AttrVarHeap, !*ErrorAdmin) @@ -1153,11 +1153,11 @@ where where check_global_attribute TA_Multi name attr_vars attr_var_heap cs # (attr_info_ptr, attr_var_heap) = newPtr AVI_Empty attr_var_heap - new_var = { av_name = emptyIdent name, av_info_ptr = attr_info_ptr} + new_var = { av_ident = emptyIdent name, av_info_ptr = attr_info_ptr} = (TA_Var new_var, [new_var : attr_vars], attr_var_heap, cs) check_global_attribute TA_None name attr_vars attr_var_heap cs # (attr_info_ptr, attr_var_heap) = newPtr AVI_Empty attr_var_heap - new_var = { av_name = emptyIdent name, av_info_ptr = attr_info_ptr} + new_var = { av_ident = emptyIdent name, av_info_ptr = attr_info_ptr} = (TA_Var new_var, [new_var : attr_vars], attr_var_heap, cs) check_global_attribute _ name attr_vars attr_var_heap cs = (TA_Multi, attr_vars, attr_var_heap, checkError name "specified attribute variable not allowed" cs) @@ -1169,7 +1169,7 @@ where check_rank_two_attribute TA_Anonymous attr_vars attr_var_heap cs = abort "check_rank_two_attribute (TA_Anonymous, check_types.icl)" /* # (attr_info_ptr, attr_var_heap) = newPtr AVI_Empty attr_var_heap - new_var = { av_name = emptyIdent name, av_info_ptr = attr_info_ptr} + new_var = { av_ident = emptyIdent name, av_info_ptr = attr_info_ptr} = (TA_Var new_var, [new_var : attr_vars], attr_var_heap, cs) */ check_rank_two_attribute attr attr_vars attr_var_heap cs = (attr, attr_vars, attr_var_heap, cs) @@ -1181,21 +1181,21 @@ addExistentionalTypeVariablesToSymbolTable root_attr type_vars heaps cs where add_exi_variable_to_symbol_table :: !TypeAttribute !ATypeVar !(!*TypeHeaps, !*CheckState) -> (!ATypeVar, !(!*TypeHeaps, !*CheckState)) - add_exi_variable_to_symbol_table root_attr atv=:{atv_variable=atv_variable=:{tv_name}, atv_attribute} + add_exi_variable_to_symbol_table root_attr atv=:{atv_variable=atv_variable=:{tv_ident}, atv_attribute} (heaps=:{th_vars,th_attrs}, cs=:{ cs_symbol_table, cs_error}) - # tv_info = tv_name.id_info + # tv_info = tv_ident.id_info (entry, cs_symbol_table) = readPtr tv_info cs_symbol_table | entry.ste_def_level < cGlobalScope // cOuterMostLevel # (tv_info_ptr, th_vars) = newPtr TVI_Empty th_vars atv_variable = { atv_variable & tv_info_ptr = tv_info_ptr } - (atv_attribute, th_attrs, cs_error) = check_attribute atv_attribute root_attr tv_name.id_name th_attrs cs_error + (atv_attribute, th_attrs, cs_error) = check_attribute atv_attribute root_attr tv_ident.id_name th_attrs cs_error cs_symbol_table = cs_symbol_table <:= (tv_info, {ste_index = NoIndex, ste_kind = STE_BoundTypeVariable {stv_attribute = atv_attribute, stv_info_ptr = tv_info_ptr, stv_count = 0 }, ste_def_level = cGlobalScope /* cOuterMostLevel */, ste_previous = entry }) heaps = { heaps & th_vars = th_vars, th_attrs = th_attrs } = ({atv & atv_variable = atv_variable, atv_attribute = atv_attribute}, (heaps, { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error})) = (atv, ({ heaps & th_vars = th_vars }, - { cs & cs_symbol_table = cs_symbol_table, cs_error = checkError tv_name.id_name "type variable already defined" cs_error})) + { cs & cs_symbol_table = cs_symbol_table, cs_error = checkError tv_ident.id_name "type variable already defined" cs_error})) /* check_attribute :: !TypeAttribute !TypeAttribute !String !*ErrorAdmin -> (!TypeAttribute, !*ErrorAdmin) @@ -1245,7 +1245,7 @@ where removeAttributedTypeVarsFromSymbolTable :: !Level ![ATypeVar] !*SymbolTable -> *SymbolTable removeAttributedTypeVarsFromSymbolTable level vars symbol_table - = foldr (\{atv_variable={tv_name}} -> removeDefinitionFromSymbolTable level tv_name) symbol_table vars + = foldr (\{atv_variable={tv_ident}} -> removeDefinitionFromSymbolTable level tv_ident) symbol_table vars cExistentialVariable :== True @@ -1261,11 +1261,11 @@ removeDefinitionFromSymbolTable level {id_info} symbol_table removeAttributesFromSymbolTable :: ![AttributeVar] !*SymbolTable -> *SymbolTable removeAttributesFromSymbolTable attrs symbol_table - = foldr (\{av_name} -> removeDefinitionFromSymbolTable cGlobalScope av_name) symbol_table attrs + = foldr (\{av_ident} -> removeDefinitionFromSymbolTable cGlobalScope av_ident) symbol_table attrs removeVariablesFromSymbolTable :: !Int ![TypeVar] !*SymbolTable -> *SymbolTable removeVariablesFromSymbolTable scope vars symbol_table - = foldr (\{tv_name} -> removeDefinitionFromSymbolTable scope tv_name) symbol_table vars + = foldr (\{tv_ident} -> removeDefinitionFromSymbolTable scope tv_ident) symbol_table vars :: Indexes = { index_type :: !Index @@ -1346,14 +1346,14 @@ where collect_fields field_nr fields (sel_defs, symbol_table) | field_nr < size fields # (sel_defs, symbol_table) = collect_fields (inc field_nr) fields (sel_defs, symbol_table) - ({ ste_kind = STE_DictField sel_def }, symbol_table) = readPtr fields.[field_nr].fs_name.id_info symbol_table + ({ ste_kind = STE_DictField sel_def }, symbol_table) = readPtr fields.[field_nr].fs_ident.id_info symbol_table = ( [ sel_def : sel_defs ], symbol_table) = ( sel_defs, symbol_table) store_fields_in_selector_array field_nr fields (sel_defs, symbol_table) | field_nr < size fields # field = fields.[field_nr] - # ({ ste_kind = STE_DictField sel_def }, symbol_table) = readPtr field.fs_name.id_info symbol_table + # ({ ste_kind = STE_DictField sel_def }, symbol_table) = readPtr field.fs_ident.id_info symbol_table # sel_defs = {sel_defs & [field.fs_index] = sel_def } = store_fields_in_selector_array (inc field_nr) fields (sel_defs, symbol_table) = ( sel_defs, symbol_table) @@ -1393,11 +1393,11 @@ where create_class_dictionary :: !Index !Index !*{#ClassDef} !w:{#DclModule} !u:Indexes !*TypeVarHeap !*VarHeap !*SymbolTable -> (!*{#ClassDef}, !w:{#DclModule}, !SymbolPtr, !u:Indexes, !*TypeVarHeap, !*VarHeap, !*SymbolTable) create_class_dictionary mod_index class_index class_defs =:{[class_index] = class_def } modules indexes type_var_heap var_heap symbol_table - # {class_name,class_args,class_arity,class_members,class_context,class_dictionary=ds=:{ds_ident={id_name,id_info}}} = class_def + # {class_ident,class_args,class_arity,class_members,class_context,class_dictionary=ds=:{ds_ident={id_name,id_info}}} = class_def # (type_id_info, symbol_table) = newPtr EmptySymbolTableEntry symbol_table nr_of_members = size class_members nr_of_fields = nr_of_members + length class_context - rec_type_id = { class_name & id_info = type_id_info} + rec_type_id = { class_ident & id_info = type_id_info} class_dictionary = { ds & ds_ident = rec_type_id } { index_type, index_cons, index_selector } = indexes @@ -1414,14 +1414,14 @@ where [ field_type \\ i <- [1..nr_of_members] ] class_defs modules var_heap symbol_table (cons_id_info, symbol_table) = newPtr EmptySymbolTableEntry symbol_table - rec_cons_id = { class_name & id_info = cons_id_info} + rec_cons_id = { class_ident & id_info = cons_id_info} cons_symbol = { ds_ident = rec_cons_id, ds_arity = nr_of_fields, ds_index = index_cons } (cons_type_ptr, var_heap) = newPtr VI_Empty var_heap (td_args, type_var_heap) = mapSt new_attributed_type_variable class_args type_var_heap type_def = - { td_name = rec_type_id + { td_ident = rec_type_id , td_index = index_type , td_arity = 0 , td_args = td_args @@ -1434,7 +1434,7 @@ where } cons_def = - { cons_symb = rec_cons_id + { cons_ident = rec_cons_id , cons_type = { st_vars = [], st_args = reverse rev_field_types, st_args_strictness = first_n_strict nr_of_fields, st_result = rec_type, st_arity = nr_of_fields, st_context = [], st_attr_vars = [], st_attr_env = [] } , cons_priority = NoPrio @@ -1468,10 +1468,10 @@ where build_context_fields mod_index field_nr [{tc_class = TCClass {glob_module, glob_object={ds_index}}}:tcs] rec_type rec_type_index next_selector_index rev_fields rev_field_types class_defs modules var_heap symbol_table - # ({class_name, class_arity, class_dictionary = {ds_ident, ds_index}}, _, class_defs, modules) = getClassDef ds_index glob_module mod_index class_defs modules + # ({class_ident, class_arity, class_dictionary = {ds_ident, ds_index}}, _, class_defs, modules) = getClassDef ds_index glob_module mod_index class_defs modules type_symb = MakeTypeSymbIdent { glob_object = ds_index, glob_module = glob_module } ds_ident class_arity field_type = makeAttributedType TA_Multi (TA type_symb [makeAttributedType TA_Multi TE \\ i <- [1..class_arity]]) - (field, var_heap, symbol_table) = build_field field_nr class_name.id_name rec_type_index rec_type field_type next_selector_index var_heap symbol_table + (field, var_heap, symbol_table) = build_field field_nr class_ident.id_name rec_type_index rec_type field_type next_selector_index var_heap symbol_table = build_context_fields mod_index (inc field_nr) tcs rec_type rec_type_index (inc next_selector_index) [ field : rev_fields ] [field_type : rev_field_types] class_defs modules var_heap symbol_table build_context_fields mod_index field_nr [{tc_class = TCGeneric {gtc_generic, gtc_kind}} :tcs] rec_type rec_type_index @@ -1479,8 +1479,8 @@ where // FIXME: We do not know the type before the generic phase. // The generic phase currently does not update the type. # field_type = makeAttributedType TA_Multi TE - # class_name = genericIdentToClassIdent gtc_generic.glob_object.ds_ident gtc_kind - # (field, var_heap, symbol_table) = build_field field_nr class_name.id_name rec_type_index rec_type field_type next_selector_index var_heap symbol_table + # class_ident = genericIdentToClassIdent gtc_generic.glob_object.ds_ident gtc_kind + # (field, var_heap, symbol_table) = build_field field_nr class_ident.id_name rec_type_index rec_type field_type next_selector_index var_heap symbol_table = build_context_fields mod_index (inc field_nr) tcs rec_type rec_type_index (inc next_selector_index) [ field : rev_fields ] [field_type : rev_field_types] class_defs modules var_heap symbol_table build_context_fields mod_index field_nr [] rec_type rec_type_index next_selector_index rev_fields rev_field_types class_defs modules var_heap symbol_table @@ -1491,7 +1491,7 @@ where (sd_type_ptr, var_heap) = newPtr VI_Empty var_heap field_id = { id_name = field_name, id_info = id_info } sel_def = - { sd_symb = field_id + { sd__ident = field_id , sd_field = field_id , sd_type = { st_vars = [], st_args = [ rec_type ], st_args_strictness=Strict 1, st_result = field_type, st_arity = 1, st_context = [], st_attr_vars = [], st_attr_env = [] } @@ -1501,7 +1501,7 @@ where , sd_type_ptr = sd_type_ptr , sd_pos = NoPos } - field = { fs_name = field_id, fs_var = field_id, fs_index = selector_index } + field = { fs_ident = field_id, fs_var = field_id, fs_index = selector_index } = (field, var_heap, symbol_table <:= (id_info, { ste_kind = STE_DictField sel_def, ste_index = selector_index, ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" })) @@ -1509,11 +1509,11 @@ class toVariable var :: !STE_Kind !Ident -> var instance toVariable TypeVar where - toVariable (STE_TypeVariable info_ptr) ident = { tv_name = ident, tv_info_ptr = info_ptr } + toVariable (STE_TypeVariable info_ptr) ident = { tv_ident = ident, tv_info_ptr = info_ptr } instance toVariable AttributeVar where - toVariable (STE_TypeAttribute info_ptr) ident = { av_name = ident, av_info_ptr = info_ptr } + toVariable (STE_TypeAttribute info_ptr) ident = { av_ident = ident, av_info_ptr = info_ptr } instance <<< DynamicType where diff --git a/frontend/classify.icl b/frontend/classify.icl index 897c125..510cd47 100644 --- a/frontend/classify.icl +++ b/frontend/classify.icl @@ -304,7 +304,7 @@ class consumerRequirements a :: !a !ConsumerAnalysisRO !AnalyseInfo -> (!ConsCla instance consumerRequirements BoundVar where - consumerRequirements {var_name,var_info_ptr} _ ai=:{ai_var_heap} + consumerRequirements {var_ident,var_info_ptr} _ ai=:{ai_var_heap} # (var_info, ai_var_heap) = readPtr var_info_ptr ai_var_heap ai = { ai & ai_var_heap=ai_var_heap } = case var_info of @@ -313,7 +313,7 @@ where ai = { ai & ai_cur_ref_counts.[arg_position] = inc_ref_count ref_count } -> (temp_var, False, ai) _ - -> abort ("consumerRequirements [BoundVar] " ---> (var_name,var_info_ptr)) + -> abort ("consumerRequirements [BoundVar] " ---> (var_ident,var_info_ptr)) instance consumerRequirements Expression where consumerRequirements (Var var) common_defs ai @@ -410,7 +410,7 @@ where = ai instance consumerRequirements App where - consumerRequirements {app_symb={symb_kind = SK_Function {glob_module,glob_object},symb_name}, app_args} + consumerRequirements {app_symb={symb_kind = SK_Function {glob_module,glob_object},symb_ident}, app_args} common_defs=:(ConsumerAnalysisRO {main_dcl_module_n,stdStrictLists_module_n,imported_funs}) ai=:{ai_cons_class,ai_group_members} @@ -466,7 +466,7 @@ instance consumerRequirements App where ...*/ // ...ACTIVATE DICTIONARIES = consumerRequirements app_args common_defs ai - consumerRequirements {app_symb={symb_kind = SK_LocalMacroFunction glob_object,symb_name}, app_args} + consumerRequirements {app_symb={symb_kind = SK_LocalMacroFunction glob_object,symb_ident}, app_args} common_defs=:(ConsumerAnalysisRO {main_dcl_module_n}) ai=:{ai_cons_class,ai_group_members} | glob_object < size ai_cons_class @@ -477,7 +477,7 @@ instance consumerRequirements App where = consumerRequirements app_args common_defs ai // new alternative for generated function + reanalysis... - consumerRequirements {app_symb={symb_kind = SK_GeneratedFunction fun_info_ptr index,symb_name}, app_args} + consumerRequirements {app_symb={symb_kind = SK_GeneratedFunction fun_info_ptr index,symb_ident}, app_args} common_defs ai=:{ai_group_members} # (FI_Function {gf_cons_args={cc_args,cc_linear_bits},gf_fun_def}, ai_fun_heap) @@ -509,7 +509,7 @@ reqs_of_args fun_idx arg_idx [form_cc : ccs] [(Var arg): args] cumm_arg_class co ai = aiUnifyClassifications form_cc act_cc ai = reqs_of_args fun_idx (inc arg_idx) ccs args (combineClasses act_cc cumm_arg_class) common_defs ai where - consumerRequirements` {var_info_ptr,var_name} _ ai + consumerRequirements` {var_info_ptr,var_ident} _ ai # (var_info, ai_var_heap) = readPtr var_info_ptr ai.ai_var_heap ai = { ai & ai_var_heap=ai_var_heap } = case var_info of @@ -518,7 +518,7 @@ where ai = { ai & ai_cur_ref_counts.[arg_position] = add_dep_count (fun_idx,arg_idx) ref_count } -> (temp_var, False, ai) _ - -> abort ("reqs_of_args [BoundVar] " ---> (var_name)) + -> abort ("reqs_of_args [BoundVar] " ---> (var_ident)) reqs_of_args fun_idx arg_idx [form_cc : ccs] [arg : args] cumm_arg_class common_defs ai # (act_cc, _, ai) = consumerRequirements arg common_defs ai diff --git a/frontend/comparedefimp.icl b/frontend/comparedefimp.icl index 55850a4..6b918c1 100644 --- a/frontend/comparedefimp.icl +++ b/frontend/comparedefimp.icl @@ -34,9 +34,9 @@ where (ok, icl_cons_defs, comp_st) = compare_rhs_of_types dcl_type_def.td_rhs icl_type_def.td_rhs dcl_cons_defs icl_cons_defs comp_st | ok && dcl_type_def.td_arity==icl_type_def.td_arity = (icl_type_defs, icl_cons_defs, comp_st) - # comp_error = compareError type_def_error (newPosition icl_type_def.td_name icl_type_def.td_pos) comp_st.comp_error + # comp_error = compareError type_def_error (newPosition icl_type_def.td_ident icl_type_def.td_pos) comp_st.comp_error = (icl_type_defs, icl_cons_defs, { comp_st & comp_error = comp_error }) -// ---> ("compare_type_defs", dcl_type_def.td_name, dcl_type_def.td_rhs, icl_type_def.td_name, icl_type_def.td_rhs) +// ---> ("compare_type_defs", dcl_type_def.td_ident, dcl_type_def.td_rhs, icl_type_def.td_ident, icl_type_def.td_rhs) = (icl_type_defs, icl_cons_defs, comp_st) compare_rhs_of_types (AlgType dclConstructors) (AlgType iclConstructors) dcl_cons_defs icl_cons_defs comp_st @@ -111,9 +111,9 @@ where # dcl_class_def = dcl_class_defs.[class_index] (icl_class_def, icl_class_defs) = icl_class_defs![class_index] # (ok, icl_member_defs, comp_st) = compare_classes dcl_class_def dcl_member_defs icl_class_def icl_member_defs comp_st - | ok // ---> ("compare_class_defs", dcl_class_def.class_name, icl_class_def.class_name) + | ok // ---> ("compare_class_defs", dcl_class_def.class_ident, icl_class_def.class_ident) = (icl_class_defs, icl_member_defs, comp_st) - # comp_error = compareError class_def_error (newPosition icl_class_def.class_name icl_class_def.class_pos) comp_st.comp_error + # comp_error = compareError class_def_error (newPosition icl_class_def.class_ident icl_class_def.class_pos) comp_st.comp_error = (icl_class_defs, icl_member_defs, { comp_st & comp_error = comp_error }) = (icl_class_defs, icl_member_defs, comp_st) @@ -176,7 +176,7 @@ where # (ok2, comp_st) = compare dcl_generic_def.gen_vars icl_generic_def.gen_vars comp_st | ok1 && ok2 = (icl_generic_defs, comp_st) - # comp_error = compareError generic_def_error (newPosition icl_generic_def.gen_name icl_generic_def.gen_pos) comp_st.comp_error + # comp_error = compareError generic_def_error (newPosition icl_generic_def.gen_ident icl_generic_def.gen_pos) comp_st.comp_error = (icl_generic_defs, { comp_st & comp_error = comp_error }) | otherwise = (icl_generic_defs, comp_st) @@ -480,7 +480,7 @@ compareTwoFunctionTypes /*conversions*/ dcl_fun_types dclIndex (icl_functions, t = case fun_type of No -> generate_error "type of exported function is missing" fun_def icl_functions tc_state error_admin Yes icl_symbol_type - # {ft_type=dcl_symbol_type, ft_priority,ft_symb} = dcl_fun_types.[dclIndex] + # {ft_type=dcl_symbol_type, ft_priority,ft_ident} = dcl_fun_types.[dclIndex] # tc_state = init_symbol_type_vars dcl_symbol_type icl_symbol_type tc_state (corresponds, tc_state) = t_corresponds dcl_symbol_type icl_symbol_type tc_state // --->("comparing:", dcl_symbol_type ,icl_symbol_type) @@ -583,38 +583,38 @@ compareTwoMacroFuns macro_module_index dclIndex iclIndex ec_state=:{ec_icl_funct ec_state = { ec_state & ec_error_admin = ec_error_admin } | dcl_function.fun_info.fi_properties bitand FI_IsMacroFun <> icl_function.fun_info.fi_properties bitand FI_IsMacroFun || dcl_function.fun_priority<>icl_function.fun_priority - # ec_state = give_error dcl_function.fun_symb ec_state + # ec_state = give_error dcl_function.fun_ident ec_state = { ec_state & ec_error_admin = popErrorAdmin ec_state.ec_error_admin } # ec_state = e_corresponds dcl_function.fun_body icl_function.fun_body ec_state = { ec_state & ec_error_admin = popErrorAdmin ec_state.ec_error_admin } instance getIdentPos (TypeDef a) where - getIdentPos {td_name, td_pos} - = newPosition td_name td_pos + getIdentPos {td_ident, td_pos} + = newPosition td_ident td_pos instance getIdentPos ConsDef where - getIdentPos {cons_symb, cons_pos} - = newPosition cons_symb cons_pos + getIdentPos {cons_ident, cons_pos} + = newPosition cons_ident cons_pos instance getIdentPos SelectorDef where - getIdentPos {sd_symb, sd_pos} - = newPosition sd_symb sd_pos + getIdentPos {sd__ident, sd_pos} + = newPosition sd__ident sd_pos instance getIdentPos ClassDef where - getIdentPos {class_name, class_pos} - = newPosition class_name class_pos + getIdentPos {class_ident, class_pos} + = newPosition class_ident class_pos instance getIdentPos MemberDef where - getIdentPos {me_symb, me_pos} - = newPosition me_symb me_pos + getIdentPos {me_ident, me_pos} + = newPosition me_ident me_pos instance getIdentPos ClassInstance where getIdentPos {ins_ident, ins_pos} = newPosition ins_ident ins_pos instance getIdentPos FunDef where - getIdentPos {fun_symb, fun_pos} - = newPosition fun_symb fun_pos + getIdentPos {fun_ident, fun_pos} + = newPosition fun_ident fun_pos instance CorrespondenceNumber VarInfo where toCorrespondenceNumber (VI_CorrespondenceNumber number) @@ -804,21 +804,21 @@ instance t_corresponds AttributeVar where instance t_corresponds Type where t_corresponds (TA dclIdent dclArgs) icl_type=:(TA iclIdent iclArgs) - = equal dclIdent.type_name iclIdent.type_name + = equal dclIdent.type_ident iclIdent.type_ident &&& equal dclIdent.type_index.glob_module iclIdent.type_index.glob_module &&& t_corresponds dclArgs iclArgs t_corresponds (TA dclIdent dclArgs) icl_type=:(TAS iclIdent iclArgs iclStrictness) - = equal dclIdent.type_name iclIdent.type_name + = equal dclIdent.type_ident iclIdent.type_ident &&& equal dclIdent.type_index.glob_module iclIdent.type_index.glob_module &&& return (equal_strictness_lists NotStrict iclStrictness) &&& t_corresponds dclArgs iclArgs t_corresponds (TAS dclIdent dclArgs dclStrictness) icl_type=:(TA iclIdent iclArgs) - = equal dclIdent.type_name iclIdent.type_name + = equal dclIdent.type_ident iclIdent.type_ident &&& equal dclIdent.type_index.glob_module iclIdent.type_index.glob_module &&& return (equal_strictness_lists dclStrictness NotStrict) &&& t_corresponds dclArgs iclArgs t_corresponds (TAS dclIdent dclArgs dclStrictness) icl_type=:(TAS iclIdent iclArgs iclStrictness) - = equal dclIdent.type_name iclIdent.type_name + = equal dclIdent.type_ident iclIdent.type_ident &&& equal dclIdent.type_index.glob_module iclIdent.type_index.glob_module &&& return (equal_strictness_lists dclStrictness iclStrictness) &&& t_corresponds dclArgs iclArgs @@ -881,13 +881,13 @@ instance t_corresponds RecordType where instance t_corresponds FieldSymbol where t_corresponds dclField iclField - = equal dclField.fs_name iclField.fs_name + = equal dclField.fs_ident iclField.fs_ident instance t_corresponds ConsDef where t_corresponds dclDef iclDef = do (init_atype_vars (dclDef.cons_exi_vars++iclDef.cons_exi_vars)) &&& t_corresponds dclDef.cons_type iclDef.cons_type - &&& equal dclDef.cons_symb iclDef.cons_symb + &&& equal dclDef.cons_ident iclDef.cons_ident &&& equal dclDef.cons_priority iclDef.cons_priority instance t_corresponds SelectorDef where @@ -920,7 +920,7 @@ instance t_corresponds AttrInequality where instance t_corresponds ClassDef where t_corresponds dclDef iclDef = do (init_type_vars (dclDef.class_args++iclDef.class_args)) - &&& equal dclDef.class_name iclDef.class_name + &&& equal dclDef.class_ident iclDef.class_ident &&& t_corresponds dclDef.class_args iclDef.class_args &&& t_corresponds dclDef.class_context iclDef.class_context &&& t_corresponds dclDef.class_members iclDef.class_members @@ -929,7 +929,7 @@ instance t_corresponds MemberDef where t_corresponds dclDef iclDef = do (init_type_vars (dclDef.me_type.st_vars++iclDef.me_type.st_vars)) &&& do (init_attr_vars (dclDef.me_type.st_attr_vars++iclDef.me_type.st_attr_vars)) - &&& equal dclDef.me_symb iclDef.me_symb + &&& equal dclDef.me_ident iclDef.me_ident &&& equal dclDef.me_offset iclDef.me_offset &&& equal dclDef.me_priority iclDef.me_priority &&& t_corresponds dclDef.me_type iclDef.me_type @@ -994,7 +994,7 @@ instance e_corresponds FunctionBody where instance e_corresponds FreeVar where e_corresponds dclVar iclVar - = e_corresponds_VarInfoPtr iclVar.fv_name dclVar.fv_info_ptr iclVar.fv_info_ptr + = e_corresponds_VarInfoPtr iclVar.fv_ident dclVar.fv_info_ptr iclVar.fv_info_ptr instance e_corresponds Expression where // the following alternatives don't occur anymore: Lambda, Conditional, WildCard @@ -1161,11 +1161,11 @@ instance e_corresponds {#Char} where instance e_corresponds BoundVar where e_corresponds dcl icl - = e_corresponds_VarInfoPtr icl.var_name dcl.var_info_ptr icl.var_info_ptr + = e_corresponds_VarInfoPtr icl.var_ident dcl.var_info_ptr icl.var_info_ptr instance e_corresponds FieldSymbol where e_corresponds dclField iclField - = equal2 dclField.fs_name iclField.fs_name + = equal2 dclField.fs_ident iclField.fs_ident e_corresponds_VarInfoPtr ident dclPtr iclPtr ec_state=:{ec_var_heap} # (unifiable, ec_var_heap) = tryToUnifyVars dclPtr iclPtr ec_var_heap @@ -1178,59 +1178,59 @@ e_corresponds_VarInfoPtr ident dclPtr iclPtr ec_state=:{ec_var_heap} The problem: also different symbols can correspond with each other, because for macros all local functions (also lambda functions) will be generated twice. */ -e_corresponds_app_symb dcl_app_symb=:{symb_name, symb_kind=SK_Function dcl_glob_index} +e_corresponds_app_symb dcl_app_symb=:{symb_ident, symb_kind=SK_Function dcl_glob_index} icl_app_symb=:{symb_kind=SK_Function icl_glob_index} ec_state #! main_dcl_module_n = ec_state.ec_main_dcl_module_n | dcl_glob_index.glob_module==main_dcl_module_n && icl_glob_index.glob_module==main_dcl_module_n | dcl_glob_index.glob_object<>icl_glob_index.glob_object - = give_error symb_name ec_state + = give_error symb_ident ec_state = ec_state | dcl_glob_index<>icl_glob_index - = give_error symb_name ec_state + = give_error symb_ident ec_state = ec_state -e_corresponds_app_symb dcl_app_symb=:{symb_name, symb_kind=SK_OverloadedFunction dcl_glob_index} +e_corresponds_app_symb dcl_app_symb=:{symb_ident, symb_kind=SK_OverloadedFunction dcl_glob_index} icl_app_symb=:{symb_kind=SK_OverloadedFunction icl_glob_index} ec_state | dcl_glob_index<>icl_glob_index - = give_error symb_name ec_state + = give_error symb_ident ec_state = ec_state -e_corresponds_app_symb dcl_app_symb=:{symb_name, symb_kind=SK_Generic dcl_glob_index dcl_kind} +e_corresponds_app_symb dcl_app_symb=:{symb_ident, symb_kind=SK_Generic dcl_glob_index dcl_kind} icl_app_symb=:{symb_kind=SK_Generic icl_glob_index icl_kind} ec_state | dcl_glob_index<>icl_glob_index || dcl_kind <> icl_kind - = give_error symb_name ec_state + = give_error symb_ident ec_state = ec_state e_corresponds_app_symb dcl_app_symb=:{symb_kind=SK_DclMacro dcl_glob_index} icl_app_symb=:{symb_kind=SK_IclMacro icl_index} ec_state = continuation_for_possibly_twice_defined_macros dcl_app_symb dcl_glob_index.glob_module dcl_glob_index.glob_object icl_app_symb icl_index ec_state -e_corresponds_app_symb dcl_app_symb=:{symb_name,symb_kind=SK_DclMacro dcl_glob_index} icl_app_symb=:{symb_kind=SK_DclMacro icl_glob_index} ec_state +e_corresponds_app_symb dcl_app_symb=:{symb_ident,symb_kind=SK_DclMacro dcl_glob_index} icl_app_symb=:{symb_kind=SK_DclMacro icl_glob_index} ec_state | dcl_glob_index==icl_glob_index = ec_state - = give_error symb_name ec_state + = give_error symb_ident ec_state e_corresponds_app_symb dcl_app_symb=:{symb_kind=SK_LocalDclMacroFunction dcl_glob_index} icl_app_symb=:{symb_kind=SK_LocalMacroFunction icl_index} ec_state = continuation_for_possibly_twice_defined_macros dcl_app_symb dcl_glob_index.glob_module dcl_glob_index.glob_object icl_app_symb icl_index ec_state -e_corresponds_app_symb {symb_name=dcl_symb_name, symb_kind=SK_Constructor dcl_glob_index} {symb_name=icl_symb_name, symb_kind=SK_Constructor icl_glob_index} ec_state +e_corresponds_app_symb {symb_ident=dcl_symb_name, symb_kind=SK_Constructor dcl_glob_index} {symb_ident=icl_symb_name, symb_kind=SK_Constructor icl_glob_index} ec_state | dcl_glob_index.glob_module==icl_glob_index.glob_module && dcl_symb_name.id_name==icl_symb_name.id_name = ec_state = give_error icl_symb_name ec_state -//e_corresponds_app_symb {symb_name} _ ec_state -e_corresponds_app_symb {symb_name,symb_kind} {symb_kind=symb_kind2} ec_state - = give_error symb_name ec_state +//e_corresponds_app_symb {symb_ident} _ ec_state +e_corresponds_app_symb {symb_ident,symb_kind} {symb_kind=symb_kind2} ec_state + = give_error symb_ident ec_state continuation_for_possibly_twice_defined_macros dcl_app_symb dcl_module_index dcl_index icl_app_symb icl_index ec_state | icl_index==NoIndex = ec_state // two different functions were referenced. In case of macro functions they still could correspond | not (names_are_compatible dcl_index icl_index ec_state.ec_icl_functions ec_state.ec_macro_defs) - = give_error icl_app_symb.symb_name ec_state + = give_error icl_app_symb.symb_ident ec_state | dcl_module_index<>ec_state.ec_main_dcl_module_n - = give_error icl_app_symb.symb_name ec_state + = give_error icl_app_symb.symb_ident ec_state | ec_state.ec_dcl_correspondences.[dcl_index]==icl_index && ec_state.ec_icl_correspondences.[icl_index]==dcl_index = ec_state | ec_state.ec_dcl_correspondences.[dcl_index]==cNoCorrespondence && ec_state.ec_icl_correspondences.[icl_index]==cNoCorrespondence // going into recursion is save = compareTwoMacroFuns dcl_module_index dcl_index icl_index ec_state - = give_error icl_app_symb.symb_name ec_state + = give_error icl_app_symb.symb_ident ec_state where names_are_compatible :: Int Int {#FunDef} {#{#FunDef}} -> Bool; names_are_compatible dcl_index icl_index icl_functions macro_defs @@ -1239,7 +1239,7 @@ continuation_for_possibly_twice_defined_macros dcl_app_symb dcl_module_index dcl dcl_name_is_loc_dependent = name_is_location_dependent dcl_function.fun_kind icl_name_is_loc_dependent = name_is_location_dependent icl_function.fun_kind = (dcl_name_is_loc_dependent==icl_name_is_loc_dependent) - && (implies (not dcl_name_is_loc_dependent) (dcl_function.fun_symb.id_name==icl_function.fun_symb.id_name)) + && (implies (not dcl_name_is_loc_dependent) (dcl_function.fun_ident.id_name==icl_function.fun_ident.id_name)) // functions that originate from e.g. lambda expressions can correspond although their names differ where name_is_location_dependent (FK_Function name_is_loc_dependent) diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl index 99c0347..5957f02 100644 --- a/frontend/convertDynamics.icl +++ b/frontend/convertDynamics.icl @@ -224,7 +224,7 @@ instance convertDynamics TransformedBody where # (bind_global_tpv_symb, ci) = getSymbol PD_Dyn_bind_global_type_pattern_var SK_Function 3 ci # type_code - = {var_name = a_ij_var_name, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr} + = {var_ident = a_ij_var_name, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr} # (unify_subst_var, ci) = newVariable "gtpv_subst" VI_Empty ci unify_subst_fv @@ -641,9 +641,9 @@ where constructorExp :: Index ((Global Index) -> SymbKind) Int !*ConversionState -> (Expression, !*ConversionState) constructorExp index symb_kind arity ci - # (cons_symb, ci) + # (cons_ident, ci) = getSymbol index symb_kind arity ci - = (App {app_symb = cons_symb, app_args = [], app_info_ptr = nilPtr}, ci) + = (App {app_symb = cons_ident, app_args = [], app_info_ptr = nilPtr}, ci) typeConstructor (GTT_PredefTypeConstructor {glob_object=type_index}) ci | PD_Arity2TupleTypeIndex <= type_index && type_index <= PD_Arity32TupleTypeIndex @@ -656,8 +656,8 @@ where # predef_type_index = type_index + FirstTypePredefinedSymbolIndex = constructorExp (predefinedTypeConstructor predef_type_index) SK_Function 0 ci - typeConstructor (GTT_Constructor cons_symb _) ci - = (App {app_symb = cons_symb, app_args = [], app_info_ptr = nilPtr}, ci) + typeConstructor (GTT_Constructor cons_ident _) ci + = (App {app_symb = cons_ident, app_args = [], app_info_ptr = nilPtr}, ci) typeConstructor (GTT_Basic basic_type) ci = constructorExp (basicTypeConstructor basic_type) SK_Function 0 ci typeConstructor GTT_Function ci @@ -757,18 +757,18 @@ createTypePatternVariable ci /**************************************************************************************************/ newVariable :: String !VarInfo !*ConversionState -> *(!BoundVar,!*ConversionState) -newVariable var_name var_info ci=:{ci_var_heap} +newVariable var_ident var_info ci=:{ci_var_heap} # (var_info_ptr, ci_var_heap) = newPtr var_info ci_var_heap - = ( { var_name = {id_name = var_name, id_info = nilPtr}, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr}, + = ( { var_ident = {id_name = var_ident, id_info = nilPtr}, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr}, { ci & ci_var_heap = ci_var_heap }) varToFreeVar :: BoundVar Int -> FreeVar -varToFreeVar {var_name, var_info_ptr} count - = {fv_def_level = NotALevel, fv_name = var_name, fv_info_ptr = var_info_ptr, fv_count = count} +varToFreeVar {var_ident, var_info_ptr} count + = {fv_def_level = NotALevel, fv_ident = var_ident, fv_info_ptr = var_info_ptr, fv_count = count} freeVarToVar :: FreeVar -> BoundVar -freeVarToVar {fv_name, fv_info_ptr} - = { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr} +freeVarToVar {fv_ident, fv_info_ptr} + = { var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr} getResultType :: ExprInfoPtr !*ConversionState -> (!AType, !*ConversionState) @@ -781,7 +781,7 @@ getSymbol index symb_kind arity ci=:{ci_predef_symb} # ({pds_module, pds_def}, ci_predef_symb) = ci_predef_symb![index] # pds_ident = predefined_idents.[index] ci = {ci & ci_predef_symb = ci_predef_symb} - symbol = { symb_name = pds_ident, symb_kind = symb_kind { glob_module = pds_module, glob_object = pds_def} } + symbol = { symb_ident = pds_ident, symb_kind = symb_kind { glob_module = pds_module, glob_object = pds_def} } = (symbol, ci) getTupleSymbol arity ci=:{ci_predef_symb} @@ -846,7 +846,7 @@ create_dynamic_and_selector_idents common_defs predefined_symbols # dynamic_temp_symb_ident = { SymbIdent | - symb_name = rt_constructor.ds_ident + symb_ident = rt_constructor.ds_ident , symb_kind = SK_Constructor {glob_module = pds_module1, glob_object = rt_constructor.ds_index} } = ({ dr_type_ident = dynamic_temp_symb_ident diff --git a/frontend/convertcases.icl b/frontend/convertcases.icl index 0c5d229..2b7496f 100644 --- a/frontend/convertcases.icl +++ b/frontend/convertcases.icl @@ -50,9 +50,9 @@ where convert_function group_index dcl_functions common_defs main_dcl_module_n fun (fun_defs, collected_imports, cs) # (fun_def, fun_defs) = fun_defs![fun] - # {fun_body,fun_type} = fun_def -*-> ("*** converting ****", fun_def.fun_symb.id_name) + # {fun_body,fun_type} = fun_def -*-> ("*** converting ****", fun_def.fun_ident.id_name) (fun_body, (collected_imports, cs)) = eliminate_code_sharing_in_function dcl_functions main_dcl_module_n common_defs fun_body /* (fun_body - ("convert_function", fun_def.fun_symb, fun_body)) */ (collected_imports, cs) + ("convert_function", fun_def.fun_ident, fun_body)) */ (collected_imports, cs) (fun_body, cs) = convertCasesInBody fun_body fun_type group_index common_defs cs = ({fun_defs & [fun].fun_body = fun_body }, collected_imports, cs) @@ -73,10 +73,10 @@ where -*-> ("eliminate_code_sharing_in_function (distributeLets)", 2, tb_rhs) split :: SymbKind (ImportedFunctions, ImportedConstructors) -> (ImportedFunctions, ImportedConstructors) - split (SK_Function fun_symb) (collected_functions, collected_conses) - = ([fun_symb : collected_functions], collected_conses) - split (SK_Constructor cons_symb) (collected_functions, collected_conses) - = (collected_functions, [ cons_symb : collected_conses]) + split (SK_Function fun_ident) (collected_functions, collected_conses) + = ([fun_ident : collected_functions], collected_conses) + split (SK_Constructor cons_ident) (collected_functions, collected_conses) + = (collected_functions, [ cons_ident : collected_conses]) // sanity check ... class checkCaseTypes a :: !a !*ExpressionHeap -> (!Bool, !*ExpressionHeap) @@ -243,7 +243,7 @@ class weightedRefCount e :: RCInfo !e !*RCState -> *RCState instance weightedRefCount BoundVar where - weightedRefCount rci=:{rci_depth} {var_name,var_info_ptr} rs=:{rcs_var_heap} + weightedRefCount rci=:{rci_depth} {var_ident,var_info_ptr} rs=:{rcs_var_heap} # (var_info, rcs_var_heap) = readPtr var_info_ptr rcs_var_heap rs = { rs & rcs_var_heap = rcs_var_heap } = case var_info of @@ -255,7 +255,7 @@ where rcs_var_heap = rs.rcs_var_heap <:= (var_info_ptr, VI_LetVar {lvi & lvi_expression = EE, lvi_new = False})} (VI_LetVar lvi, rcs_var_heap) = readPtr var_info_ptr rs.rcs_var_heap -> { rs & rcs_var_heap = rcs_var_heap <:= (var_info_ptr, VI_LetVar { lvi & lvi_expression = lvi_expression }) } -// -*-> (var_name, var_info_ptr, depth, lvi.lvi_count) +// -*-> (var_ident, var_info_ptr, depth, lvi.lvi_count) // otherwise -> { rs & rcs_var_heap = rs.rcs_var_heap <:= (var_info_ptr, VI_LetVar lvi) } _ @@ -288,23 +288,23 @@ where where remove_variable ([], var_heap) let_bind = ([], var_heap) - remove_variable ([var_ptr : var_ptrs], var_heap) bind=:{lb_dst={fv_name,fv_info_ptr}} + remove_variable ([var_ptr : var_ptrs], var_heap) bind=:{lb_dst={fv_ident,fv_info_ptr}} | fv_info_ptr == var_ptr # (VI_LetVar {lvi_count,lvi_depth}, var_heap) = readPtr fv_info_ptr var_heap = (var_ptrs, var_heap) -// -*-> ("remove_variable (lvi_count,lvi_dpeth) ", fv_name, lvi_count, lvi_depth) +// -*-> ("remove_variable (lvi_count,lvi_dpeth) ", fv_ident, lvi_count, lvi_depth) // otherwise # (var_ptrs, var_heap) = remove_variable (var_ptrs, var_heap) bind = ([var_ptr : var_ptrs], var_heap) - store_binding depth {lb_dst={fv_name,fv_info_ptr},lb_src} var_heap + store_binding depth {lb_dst={fv_ident,fv_info_ptr},lb_src} var_heap = var_heap <:= (fv_info_ptr, VI_LetVar {lvi_count = 0, lvi_depth = depth, lvi_previous = [], - lvi_new = True, lvi_expression = lb_src, lvi_var = fv_name}) + lvi_new = True, lvi_expression = lb_src, lvi_var = fv_ident}) - get_ref_count {lb_dst={fv_name,fv_info_ptr}} var_heap + get_ref_count {lb_dst={fv_ident,fv_info_ptr}} var_heap # (VI_LetVar {lvi_count}, var_heap) = readPtr fv_info_ptr var_heap = (lvi_count, var_heap) -// -*-> (fv_name,fv_info_ptr,lvi_count) +// -*-> (fv_ident,fv_info_ptr,lvi_count) weightedRefCount rci (Case case_expr) rs=:{rcs_expr_heap} /* // sanity check ... @@ -484,7 +484,7 @@ where where check_import cii {symb_kind=SK_Function {glob_module,glob_object}} rs=:{rcs_imports, rcs_var_heap} = checkImportOfDclFunction cii glob_module glob_object rs - check_import {cii_main_dcl_module_n, cii_common_defs} {symb_name,symb_kind=symb_kind=:(SK_Constructor {glob_module,glob_object})} rs=:{rcs_imports, rcs_var_heap} + check_import {cii_main_dcl_module_n, cii_common_defs} {symb_ident,symb_kind=symb_kind=:(SK_Constructor {glob_module,glob_object})} rs=:{rcs_imports, rcs_var_heap} | glob_module <> cii_main_dcl_module_n # {cons_type_ptr} = cii_common_defs.[glob_module].com_cons_defs.[glob_object] (rcs_imports, rcs_var_heap) = checkImportedSymbol symb_kind cons_type_ptr (rcs_imports, rcs_var_heap) @@ -550,7 +550,7 @@ class distributeLets e :: !DistributeInfo !e !*DistributeState -> (!e, !*Distrib instance distributeLets Expression where - distributeLets di=:{di_depth} (Var var=:{var_name,var_info_ptr}) ds=:{ds_var_heap} + distributeLets di=:{di_depth} (Var var=:{var_ident,var_info_ptr}) ds=:{ds_var_heap} #! var_info = sreadPtr var_info_ptr ds_var_heap = case var_info of VI_LetExpression lei @@ -628,7 +628,7 @@ where lei = { lei_count = ref_count, lei_depth = depth, lei_var = { lb_dst & fv_info_ptr = new_info_ptr }, lei_expression = lb_src, lei_type = type, lei_status = LES_Untouched } // -*-> ("set_let_expr_info", lb_dst.fv_info_ptr, new_info_ptr) - ->> ("set_let_expr_info", lb_dst.fv_name.id_name, depth) + ->> ("set_let_expr_info", lb_dst.fv_ident.id_name, depth) = set_let_expr_info depth binds ref_counts types (var_heap <:= (lb_dst.fv_info_ptr, VI_LetExpression lei)) set_let_expr_info _ [] _ _ var_heap = var_heap @@ -636,14 +636,14 @@ where set_strict_let_expr_info {lb_dst} var_heap = var_heap <:= (lb_dst.fv_info_ptr, VI_LocalLetVar) - distribute_lets_in_non_distributed_let di {lb_dst={fv_name,fv_info_ptr}} ds=:{ds_var_heap} + distribute_lets_in_non_distributed_let di {lb_dst={fv_ident,fv_info_ptr}} ds=:{ds_var_heap} # (VI_LetExpression lei=:{lei_count}, ds_var_heap) = readPtr fv_info_ptr ds_var_heap | lei_count > 0 // | not lei_moved && lei_count > 0 = distributeLetsInLetExpression di fv_info_ptr lei { ds & ds_var_heap = ds_var_heap } // otherwise = { ds & ds_var_heap = ds_var_heap } - -*-> ("distribute_lets_in_non_distributed_let (moved or not used)", lei_count, fv_name) + -*-> ("distribute_lets_in_non_distributed_let (moved or not used)", lei_count, fv_ident) distributeLets _ expr=:(TypeCodeExpression _) ds = (expr, ds) @@ -717,14 +717,14 @@ where = (CaseKindLeave, var_heap) where - is_lhs_var (Var {var_info_ptr, var_name}) var_heap + is_lhs_var (Var {var_info_ptr, var_ident}) var_heap = case sreadPtr var_info_ptr var_heap of VI_LocalLetVar - -> False ->> (var_name.id_name, "rhs1") + -> False ->> (var_ident.id_name, "rhs1") VI_LetExpression _ - -> False ->> (var_name.id_name, "rhs2") + -> False ->> (var_ident.id_name, "rhs2") info - -> True ->> (var_name.id_name, "lhs", info) + -> True ->> (var_ident.id_name, "lhs", info) is_lhs_var _ _ = False @@ -767,8 +767,8 @@ where # (VI_LetExpression lei=:{lei_count,lei_depth,lei_var}, var_heap) = readPtr cv_variable var_heap | lei_count == cv_count && lei_depth==depth-1 // -*-> ("mark_test", lei_count, cv_count) = ([(cv_variable, lei_count, lei_depth) : local_vars ], var_heap <:= (cv_variable, VI_LetExpression { lei & lei_depth = depth})) -// -*-> ("mark_local_let_var ", lei.lei_var.fv_name, cv_variable, (lei.lei_var.fv_info_ptr, cv_count, depth)) - ->> ("mark_local_let_var ", lei_var.fv_name.id_name, lei_depth, " ->> ", depth) +// -*-> ("mark_local_let_var ", lei.lei_var.fv_ident, cv_variable, (lei.lei_var.fv_info_ptr, cv_count, depth)) + ->> ("mark_local_let_var ", lei_var.fv_ident.id_name, lei_depth, " ->> ", depth) // otherwise = (local_vars, var_heap) @@ -776,14 +776,14 @@ where # (VI_LetExpression lei=:{lei_count,lei_depth,lei_expression}, var_heap) = readPtr cv_variable var_heap | lei_count == cv_count && lei_depth==depth-1 = case lei_expression of - TupleSelect _ _ (Var var=:{var_name,var_info_ptr}) + TupleSelect _ _ (Var var=:{var_ident,var_info_ptr}) # (var_info,var_heap) = readPtr var_info_ptr var_heap -> case var_info of VI_LetExpression lei2 -> (local_vars,[(cv_variable,lei_depth):local_select_vars],var_heap <:= (cv_variable, VI_LetExpression { lei & lei_depth = depth})) _ -> ([(cv_variable, lei_count, lei_depth) : local_vars ],local_select_vars,var_heap <:= (cv_variable, VI_LetExpression { lei & lei_depth = depth})) - Selection NormalSelector (Var var=:{var_name,var_info_ptr}) [RecordSelection _ _] + Selection NormalSelector (Var var=:{var_ident,var_info_ptr}) [RecordSelection _ _] # (var_info,var_heap) = readPtr var_info_ptr var_heap -> case var_info of VI_LetExpression lei2 @@ -798,7 +798,7 @@ where mark_local_let_select_var_of_explicit_case depth (cv_variable,old_depth) (local_vars,var_heap) # (VI_LetExpression lei=:{lei_count,lei_expression}, var_heap) = readPtr cv_variable var_heap = case lei_expression of - TupleSelect _ _ (Var var=:{var_name,var_info_ptr}) + TupleSelect _ _ (Var var=:{var_ident,var_info_ptr}) # (var_info,var_heap) = readPtr var_info_ptr var_heap -> case var_info of VI_LetExpression lei2 @@ -806,7 +806,7 @@ where -> (local_vars,var_heap <:= (cv_variable, VI_LetExpression {lei & lei_depth = old_depth})) _ -> ([(cv_variable, lei_count, old_depth) : local_vars ],var_heap) - Selection NormalSelector (Var var=:{var_name,var_info_ptr}) [RecordSelection _ _] + Selection NormalSelector (Var var=:{var_ident,var_info_ptr}) [RecordSelection _ _] # (var_info,var_heap) = readPtr var_info_ptr var_heap -> case var_info of VI_LetExpression lei2 @@ -819,7 +819,7 @@ where # (VI_LetExpression lei, var_heap) = readPtr var_info_ptr var_heap = var_heap <:= (var_info_ptr, VI_LetExpression { lei & lei_depth = lei_depth, lei_count = lei_count, lei_status = LES_Moved }) // -*-> ("reset_local_let_var", var_info_ptr) - ->> ("reset_local_let_var", lei.lei_var.fv_name.id_name, lei.lei_depth, lei.lei_count, " ->> ", lei_depth, lei_count) + ->> ("reset_local_let_var", lei.lei_var.fv_ident.id_name, lei.lei_depth, lei.lei_count, " ->> ", lei_depth, lei_count) is_outer_var {di_depth, di_explicit_case_depth} {cv_variable} (outer, var_heap) | outer @@ -846,7 +846,7 @@ where # (VI_LetExpression lei, var_heap) = readPtr cv_variable var_heap | depth == lei.lei_depth = (var_heap <:= (cv_variable, VI_LetExpression { lei & lei_count = cv_count, lei_status = LES_Untouched })) - -*-> ("mark_local_let_var_of_pattern_expr ", lei.lei_var.fv_name, cv_variable, (lei.lei_var.fv_info_ptr, cv_count, depth)) + -*-> ("mark_local_let_var_of_pattern_expr ", lei.lei_var.fv_ident, cv_variable, (lei.lei_var.fv_info_ptr, cv_count, depth)) // otherwise = var_heap @@ -860,11 +860,11 @@ where distributeLetsInLetExpression :: DistributeInfo VarInfoPtr LetExpressionInfo *DistributeState -> *DistributeState distributeLetsInLetExpression _ let_var_info_ptr {lei_status = LES_Moved, lei_var} ds - = ds -*-> ("distributeLetsInLetExpression, LES_Moved", lei_var.fv_name.id_name, let_var_info_ptr) + = ds -*-> ("distributeLetsInLetExpression, LES_Moved", lei_var.fv_ident.id_name, let_var_info_ptr) distributeLetsInLetExpression _ let_var_info_ptr {lei_status = LES_Updated _, lei_var} ds - = ds -*-> ("distributeLetsInLetExpression, LES_Updated", lei_var.fv_name.id_name, let_var_info_ptr) + = ds -*-> ("distributeLetsInLetExpression, LES_Updated", lei_var.fv_ident.id_name, let_var_info_ptr) distributeLetsInLetExpression di let_var_info_ptr lei=:{lei_expression, lei_status = LES_Untouched, lei_var} ds=:{ds_var_heap} - # ds_var_heap = ds_var_heap <:= (let_var_info_ptr, VI_LetExpression { lei & lei_status = LES_Updated EE}) /* to prevent doing this expr twice */ -*-> ("distributeLetsInLetExpression, LES_Untouched", lei_var.fv_name.id_name, let_var_info_ptr) + # ds_var_heap = ds_var_heap <:= (let_var_info_ptr, VI_LetExpression { lei & lei_status = LES_Updated EE}) /* to prevent doing this expr twice */ -*-> ("distributeLetsInLetExpression, LES_Untouched", lei_var.fv_ident.id_name, let_var_info_ptr) (lei_expression, ds) = distributeLets di lei_expression { ds & ds_var_heap = ds_var_heap } = { ds & ds_lets = [ let_var_info_ptr : ds.ds_lets ], ds_var_heap = ds.ds_var_heap <:= (let_var_info_ptr, VI_LetExpression { lei & lei_status = LES_Updated lei_expression })} @@ -896,7 +896,7 @@ where (LES_Updated updated_expr) = lei_status (new_info_ptr, var_heap) = newPtr (VI_Labelled_Empty "build_bind") var_heap var_heap = var_heap <:= (info_ptr, VI_LetExpression { lei & lei_status = LES_Untouched, lei_var = { lei_var & fv_info_ptr = new_info_ptr }}) - -*-> ("build_bind", lei_var.fv_name, info_ptr, new_info_ptr) + -*-> ("build_bind", lei_var.fv_ident, info_ptr, new_info_ptr) = ([{ lb_src = updated_expr, lb_dst = lei_var, lb_position = NoPos } : lazy_binds], [lei_type : lazy_binds_types ], var_heap) instance distributeLets Selection @@ -1258,7 +1258,7 @@ newFunctionWithType opt_id fun_bodies local_vars fun_type group_index (cs_next_f = fun_type.st_arity fun_def = - { fun_symb = fun_id + { fun_ident = fun_id , fun_arity = arity , fun_priority = NoPrio , fun_body = fun_bodies @@ -1268,7 +1268,7 @@ newFunctionWithType opt_id fun_bodies local_vars fun_type group_index (cs_next_f , fun_lifted = 0 , fun_info = { EmptyFunInfo & fi_group_index = group_index, fi_local_vars = local_vars } } - = ({ symb_name = fun_id, symb_kind = SK_GeneratedFunction fun_def_ptr cs_next_fun_nr }, + = ({ symb_ident = fun_id, symb_kind = SK_GeneratedFunction fun_def_ptr cs_next_fun_nr }, (inc cs_next_fun_nr, [fun_def_ptr : cs_new_functions], cs_fun_heap <:= (fun_def_ptr, FI_Function { gf_fun_def = fun_def, gf_instance_info = II_Empty, gf_fun_index = cs_next_fun_nr, gf_cons_args = {cc_size=0, cc_args = [], cc_linear_bits = [], cc_producer = False} }))) @@ -1761,7 +1761,7 @@ convertDefault ci=:{ci_bound_vars, ci_group_index, ci_common_defs} = copy_case_expr ci_bound_vars defoult cs.cs_var_heap cs = { cs & cs_var_heap = cs_var_heap} - (fun_symb, cs) + (fun_ident, cs) = new_case_function case_ident case_type.ct_result_type defoult form_vars local_vars ci_bound_vars ci_group_index ci_common_defs cs @@ -1770,17 +1770,17 @@ convertDefault ci=:{ci_bound_vars, ci_group_index, ci_common_defs} restore_old_fv_info_ptr_value old_fv_info_ptr_value ({fv_info_ptr},type) var_heap = writePtr fv_info_ptr old_fv_info_ptr_value var_heap # cs = { cs & cs_var_heap = cs_var_heap} - = (App { app_symb = fun_symb, app_args = act_vars, app_info_ptr = nilPtr }, cs) + = (App { app_symb = fun_ident, app_args = act_vars, app_info_ptr = nilPtr }, cs) convertNonRootFail ci=:{ci_bound_vars, ci_group_index, ci_common_defs} ident cs # result_type = { at_attribute = TA_None - , at_type = TV {tv_name = { id_name = "a", id_info = nilPtr }, tv_info_ptr = nilPtr} + , at_type = TV {tv_ident = { id_name = "a", id_info = nilPtr }, tv_info_ptr = nilPtr} } - # (fun_symb, cs) + # (fun_ident, cs) = new_case_function (Yes ident) result_type (FailExpr ident) [] [] ci_bound_vars ci_group_index ci_common_defs cs - = (App { app_symb = fun_symb, app_args = [], app_info_ptr = nilPtr }, cs) + = (App { app_symb = fun_ident, app_args = [], app_info_ptr = nilPtr }, cs) convertNonRootCase ci=:{ci_bound_vars, ci_group_index, ci_common_defs} kees=:{ case_expr, case_ident, case_info_ptr} cs # (is_degenerate, defoult) @@ -1794,7 +1794,7 @@ convertNonRootCase ci=:{ci_bound_vars, ci_group_index, ci_common_defs} kees=:{ c cs = { cs & cs_var_heap = cs_var_heap} - (fun_symb, cs) = new_case_function case_ident case_type.ct_result_type caseExpr + (fun_ident, cs) = new_case_function case_ident case_type.ct_result_type caseExpr form_vars local_vars ci_bound_vars ci_group_index ci_common_defs cs @@ -1807,7 +1807,7 @@ convertNonRootCase ci=:{ci_bound_vars, ci_group_index, ci_common_defs} kees=:{ c = var_heap # cs = { cs & cs_var_heap = cs_var_heap} - = (App { app_symb = fun_symb, app_args = act_vars, app_info_ptr = nilPtr }, cs) + = (App { app_symb = fun_ident, app_args = act_vars, app_info_ptr = nilPtr }, cs) // otherwise @@ -1817,8 +1817,8 @@ convertNonRootCase ci=:{ci_bound_vars, ci_group_index, ci_common_defs} kees=:{ c (new_info_ptr, cs_var_heap) = newPtr (VI_LocalVar) cs.cs_var_heap var_id = {id_name = "_x", id_info = nilPtr} - case_var = Var {var_name = var_id, var_info_ptr = new_info_ptr, var_expr_ptr = nilPtr} - case_free_var = { fv_def_level = NotALevel, fv_name = var_id, fv_info_ptr = new_info_ptr, fv_count = 0} + case_var = Var {var_ident = var_id, var_info_ptr = new_info_ptr, var_expr_ptr = nilPtr} + case_free_var = { fv_def_level = NotALevel, fv_ident = var_id, fv_info_ptr = new_info_ptr, fv_count = 0} kees = {kees & case_expr=case_var, case_explicit=False} @@ -1832,7 +1832,7 @@ convertNonRootCase ci=:{ci_bound_vars, ci_group_index, ci_common_defs} kees=:{ c cs = { cs & cs_var_heap = cs_var_heap} - (fun_symb, cs) = new_case_function case_ident case_type.ct_result_type caseExpr + (fun_ident, cs) = new_case_function case_ident case_type.ct_result_type caseExpr [(case_free_var, case_type.ct_pattern_type) : form_vars] local_vars ci_bound_vars ci_group_index ci_common_defs cs @@ -1845,7 +1845,7 @@ convertNonRootCase ci=:{ci_bound_vars, ci_group_index, ci_common_defs} kees=:{ c = var_heap # cs = { cs & cs_var_heap = cs_var_heap} - = (App { app_symb = fun_symb, app_args = [case_expr : act_vars], app_info_ptr = nilPtr }, cs) + = (App { app_symb = fun_ident, app_args = [case_expr : act_vars], app_info_ptr = nilPtr }, cs) where get_case_var (Var var) = var @@ -1861,7 +1861,7 @@ where copy_case_expr bound_vars guards_and_default var_heap -// # var_heap = foldSt (\({fv_name,fv_info_ptr},type) -> writePtr fv_info_ptr (VI_BoundVar type) -*-> (fv_name,fv_info_ptr)) bound_vars var_heap +// # var_heap = foldSt (\({fv_ident,fv_info_ptr},type) -> writePtr fv_info_ptr (VI_BoundVar type) -*-> (fv_ident,fv_info_ptr)) bound_vars var_heap # (old_fv_info_ptr_values,var_heap) = store_VI_BoundVar_in_bound_vars_and_save_old_values bound_vars [] var_heap with store_VI_BoundVar_in_bound_vars_and_save_old_values [({fv_info_ptr},type):bound_vars] old_fv_info_ptr_values var_heap @@ -1878,8 +1878,8 @@ copy_case_expr bound_vars guards_and_default var_heap where retrieve_variable (var_info_ptr, type) (bound_vars, free_typed_vars, var_heap) # (VI_FreeVar name new_ptr count type, var_heap) = readPtr var_info_ptr var_heap - = ( [Var { var_name = name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr} : bound_vars], - [({ fv_def_level = NotALevel, fv_name = name, fv_info_ptr = new_ptr, fv_count = count }, type) : free_typed_vars], var_heap) + = ( [Var { var_ident = name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr} : bound_vars], + [({ fv_def_level = NotALevel, fv_ident = name, fv_info_ptr = new_ptr, fv_count = count }, type) : free_typed_vars], var_heap) new_case_function opt_id result_type rhs free_vars local_vars bound_vars group_index common_defs cs=:{cs_expr_heap} @@ -1900,10 +1900,10 @@ new_case_function opt_id result_type rhs free_vars local_vars // (body, cs) // = convertCasesInBody body (Yes type) group_index common_defs cs - # (fun_symb, (cs_next_fun_nr, cs_new_functions, cs_fun_heap)) + # (fun_ident, (cs_next_fun_nr, cs_new_functions, cs_fun_heap)) = newFunctionWithType opt_id body local_vars type group_index (cs.cs_next_fun_nr, cs.cs_new_functions, cs.cs_fun_heap) - = (fun_symb, { cs & cs_fun_heap = cs_fun_heap, cs_next_fun_nr = cs_next_fun_nr, cs_new_functions = cs_new_functions }) + = (fun_ident, { cs & cs_fun_heap = cs_fun_heap, cs_next_fun_nr = cs_next_fun_nr, cs_new_functions = cs_new_functions }) splitGuards :: CasePatterns -> [CasePatterns] splitGuards (AlgebraicPatterns index patterns) @@ -1927,8 +1927,8 @@ copyExpression bound_vars expr var_heap where retrieve_variable (var_info_ptr, type) (bound_vars, free_typed_vars, var_heap) # (VI_FreeVar name new_ptr count type, var_heap) = readPtr var_info_ptr var_heap - = ( [Var { var_name = name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr} : bound_vars], - [{tv_free_var = { fv_def_level = NotALevel, fv_name = name, fv_info_ptr = new_ptr, fv_count = count }, tv_type = type} : free_typed_vars], var_heap) + = ( [Var { var_ident = name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr} : bound_vars], + [{tv_free_var = { fv_def_level = NotALevel, fv_ident = name, fv_info_ptr = new_ptr, fv_count = count }, tv_type = type} : free_typed_vars], var_heap) :: CopyState = { cp_free_vars :: ![(VarInfoPtr,AType)] @@ -1940,27 +1940,27 @@ class copy e :: !e !*CopyState -> (!e, !*CopyState) instance copy BoundVar where - copy var=:{var_name,var_info_ptr} cp_info=:{cp_var_heap} + copy var=:{var_ident,var_info_ptr} cp_info=:{cp_var_heap} # (var_info, cp_var_heap) = readPtr var_info_ptr cp_var_heap cp_info = { cp_info & cp_var_heap = cp_var_heap } = case var_info of VI_FreeVar name new_info_ptr count type -> ({ var & var_info_ptr = new_info_ptr }, { cp_info & cp_var_heap = cp_info.cp_var_heap <:= (var_info_ptr, VI_FreeVar name new_info_ptr (inc count) type)}) - -*-> ("copy: VI_FreeVar", var_name.id_name, ptrToInt var_info_ptr) + -*-> ("copy: VI_FreeVar", var_ident.id_name, ptrToInt var_info_ptr) VI_LocalVar -> (var, cp_info) - -*-> ("copy: VI_LocalVar", var_name.id_name) + -*-> ("copy: VI_LocalVar", var_ident.id_name) VI_BoundVar type # (new_info_ptr, cp_var_heap) = newPtr (VI_Labelled_Empty "copy [BoundVar]") cp_info.cp_var_heap // RWS ??? -> ({ var & var_info_ptr = new_info_ptr }, { cp_info & cp_free_vars = [ (var_info_ptr, type) : cp_info.cp_free_vars ], - cp_var_heap = cp_var_heap <:= (var_info_ptr, VI_FreeVar var_name new_info_ptr 1 type) }) - -*-> ("copy: VI_BoundVar", var_name.id_name, ptrToInt new_info_ptr) + cp_var_heap = cp_var_heap <:= (var_info_ptr, VI_FreeVar var_ident new_info_ptr 1 type) }) + -*-> ("copy: VI_BoundVar", var_ident.id_name, ptrToInt new_info_ptr) _ -// | True <<- ("copy BoundVar", var_name.id_name, ptrToInt var_info_ptr, var_info) +// | True <<- ("copy BoundVar", var_ident.id_name, ptrToInt var_info_ptr, var_info) // -> (var,cp_info) - -> abort "copy [BoundVar] (convertcases, 612)" // <<- ("copy BoundVar", var_name.id_name, ptrToInt var_info_ptr, var_info) + -> abort "copy [BoundVar] (convertcases, 612)" // <<- ("copy BoundVar", var_ident.id_name, ptrToInt var_info_ptr, var_info) instance copy Expression where diff --git a/frontend/convertimportedtypes.icl b/frontend/convertimportedtypes.icl index 96e2d6a..7f49171 100644 --- a/frontend/convertimportedtypes.icl +++ b/frontend/convertimportedtypes.icl @@ -31,7 +31,7 @@ where = iFoldSt (convert_dcl_function dcl_functions common_defs) 0 (size dcl_functions) types_and_heaps convert_dcl_function dcl_functions common_defs dcl_index (imported_types, imported_conses, var_heap, type_heaps) - #!{ft_type, ft_type_ptr, ft_symb} = dcl_functions.[dcl_index] + #!{ft_type, ft_type_ptr, ft_ident} = dcl_functions.[dcl_index] (ft_type, imported_types, imported_conses, type_heaps, var_heap) = convertSymbolType cDontRemoveAnnotations common_defs ft_type main_dcl_module_n imported_types imported_conses type_heaps var_heap = (imported_types, imported_conses, var_heap <:= (ft_type_ptr, VI_ExpandedType ft_type), type_heaps) @@ -40,7 +40,7 @@ convertConstructorTypes cons_defs main_dcl_module_n common_defs types_and_heaps = iFoldSt (convert_constructor_type common_defs cons_defs) 0 (size cons_defs) types_and_heaps where convert_constructor_type common_defs cons_defs cons_index (imported_types, imported_conses, var_heap, type_heaps) - #!{cons_type_ptr, cons_type, cons_symb} = cons_defs.[cons_index] + #!{cons_type_ptr, cons_type, cons_ident} = cons_defs.[cons_index] (cons_type, imported_types, imported_conses, type_heaps, var_heap) = convertSymbolType cDontRemoveAnnotations common_defs cons_type main_dcl_module_n imported_types imported_conses type_heaps var_heap = (imported_types, imported_conses, var_heap <:= (cons_type_ptr, VI_ExpandedType cons_type), type_heaps) @@ -49,7 +49,7 @@ convertSelectorTypes selector_defs main_dcl_module_n common_defs types_and_heaps = iFoldSt (convert_selector_type common_defs selector_defs) 0 (size selector_defs) types_and_heaps where convert_selector_type common_defs selector_defs sel_index (imported_types, imported_conses, var_heap, type_heaps) - #!{sd_type_ptr, sd_type, sd_symb} = selector_defs.[sel_index] + #!{sd_type_ptr, sd_type, sd__ident} = selector_defs.[sel_index] (sd_type, imported_types, imported_conses, type_heaps, var_heap) = convertSymbolType cDontRemoveAnnotations common_defs sd_type main_dcl_module_n imported_types imported_conses type_heaps var_heap = (imported_types, imported_conses, var_heap <:= (sd_type_ptr, VI_ExpandedType sd_type), type_heaps) @@ -98,7 +98,7 @@ where = convert_imported_constructors common_defs imported_conses imported_types type_heaps var_heap convert_imported_function dcl_functions common_defs {glob_object,glob_module} (imported_types, imported_conses, type_heaps, var_heap) - #!{ft_type_ptr,ft_type,ft_symb} = dcl_functions.[glob_module].[glob_object] + #!{ft_type_ptr,ft_type,ft_ident} = dcl_functions.[glob_module].[glob_object] (ft_type, imported_types, imported_conses, type_heaps, var_heap) = convertSymbolType cDontRemoveAnnotations common_defs ft_type main_dcl_module_n imported_types imported_conses type_heaps var_heap = (imported_types, imported_conses, type_heaps, var_heap <:= (ft_type_ptr, VI_ExpandedType ft_type)) @@ -107,12 +107,12 @@ where = (imported_types, type_heaps, var_heap) convert_imported_constructors common_defs [ {glob_module, glob_object} : conses ] imported_types type_heaps var_heap #!{com_cons_defs,com_selector_defs} = common_defs.[glob_module] - {cons_type_ptr,cons_type,cons_type_index,cons_symb} = common_defs.[glob_module].com_cons_defs.[glob_object] + {cons_type_ptr,cons_type,cons_type_index,cons_ident} = common_defs.[glob_module].com_cons_defs.[glob_object] (cons_type, imported_types, conses, type_heaps, var_heap) = convertSymbolType cDontRemoveAnnotations common_defs cons_type main_dcl_module_n imported_types conses type_heaps var_heap var_heap = var_heap <:= (cons_type_ptr, VI_ExpandedType cons_type) ({td_rhs}, imported_types) = imported_types![glob_module].[cons_type_index] - //---> ("convert_imported_constructors", cons_symb, cons_type) + //---> ("convert_imported_constructors", cons_ident, cons_type) = case td_rhs of RecordType {rt_fields} # (imported_types, conses, type_heaps, var_heap) @@ -124,7 +124,7 @@ where where convert_type_of_imported_field module_index selector_defs fields field_index (imported_types, conses, type_heaps, var_heap) #!field_index = fields.[field_index].fs_index - {sd_type_ptr,sd_type,sd_symb} = selector_defs.[field_index] + {sd_type_ptr,sd_type,sd__ident} = selector_defs.[field_index] (sd_type, imported_types, conses, type_heaps, var_heap) = convertSymbolType cDontRemoveAnnotations common_defs sd_type main_dcl_module_n imported_types conses type_heaps var_heap = (imported_types, conses, type_heaps, var_heap <:= (sd_type_ptr, VI_ExpandedType sd_type)) diff --git a/frontend/coredump.icl b/frontend/coredump.icl index f1eb40e..1d8bca4 100644 --- a/frontend/coredump.icl +++ b/frontend/coredump.icl @@ -50,9 +50,9 @@ where show_component [fun:funs] fun_defs acc_args file # (fd, fun_defs) = fun_defs![fun] | fun >= acc_max && fun < acc_min - # file = file <<< fd.fun_symb <<< '@' <<< fun <<< " ???" + # file = file <<< fd.fun_ident <<< '@' <<< fun <<< " ???" = show_component funs fun_defs acc_args file - # file = file <<< fd.fun_symb <<< '@' <<< fun <<< " (" + # file = file <<< fd.fun_ident <<< '@' <<< fun <<< " (" # (acc_arg,acc_args) = case fun < acc_min of True -> acc_args![fun] @@ -292,11 +292,11 @@ where instance <#< TypeVar where - (<#<) pp_state varid = pp_state <#< varid.tv_name + (<#<) pp_state varid = pp_state <#< varid.tv_ident instance <#< AttributeVar where - (<#<) pp_state {av_name,av_info_ptr} = pp_state <#< av_name + (<#<) pp_state {av_ident,av_info_ptr} = pp_state <#< av_ident instance <#< AType where @@ -411,20 +411,20 @@ where instance <#< SymbIdent where - (<#<) pp_state symb=:{symb_kind = SK_Function symb_index } = pp_state <#< symb.symb_name <#< '@' <#< symb_index - (<#<) pp_state symb=:{symb_kind = SK_GeneratedFunction _ symb_index } = pp_state <#< symb.symb_name <#< '@' <#< symb_index - (<#<) pp_state symb=:{symb_kind = SK_OverloadedFunction symb_index } = pp_state <#< symb.symb_name <#< "[o]@" <#< symb_index - (<#<) pp_state symb=:{symb_kind = SK_LocalMacroFunction symb_index } = pp_state <#< symb.symb_name <#< '@' <#< symb_index - (<#<) pp_state symb = pp_state <#< symb.symb_name <#< '?' + (<#<) pp_state symb=:{symb_kind = SK_Function symb_index } = pp_state <#< symb.symb_ident <#< '@' <#< symb_index + (<#<) pp_state symb=:{symb_kind = SK_GeneratedFunction _ symb_index } = pp_state <#< symb.symb_ident <#< '@' <#< symb_index + (<#<) pp_state symb=:{symb_kind = SK_OverloadedFunction symb_index } = pp_state <#< symb.symb_ident <#< "[o]@" <#< symb_index + (<#<) pp_state symb=:{symb_kind = SK_LocalMacroFunction symb_index } = pp_state <#< symb.symb_ident <#< '@' <#< symb_index + (<#<) pp_state symb = pp_state <#< symb.symb_ident <#< '?' instance <#< TypeSymbIdent where - (<#<) pp_state symb = pp_state <#< symb.type_name <#< '.' <#< symb.type_index + (<#<) pp_state symb = pp_state <#< symb.type_ident <#< '.' <#< symb.type_index instance <#< BoundVar where - (<#<) pp_state {var_name,var_info_ptr,var_expr_ptr} - = pp_state <#< var_name <#< '<' <#< ptrToInt var_info_ptr <#< '>' + (<#<) pp_state {var_ident,var_info_ptr,var_expr_ptr} + = pp_state <#< var_ident <#< '<' <#< ptrToInt var_info_ptr <#< '>' instance <#< (Bind a b) | <#< a & <#< b where @@ -577,7 +577,7 @@ where (<#<) pp_state (Constant symb _ _ _) = pp_state <#< "** Constant **" <#< symb (<#<) pp_state (ABCCodeExpr code_sequence do_inline) = pp_state <#< (if do_inline "code inline\n" "code\n") <#< code_sequence (<#<) pp_state (AnyCodeExpr input output code_sequence) = pp_state <#< "code\n" <#< input <#< '\n' <#< "" <#< output <#< '\n' <#< "" <#< code_sequence - (<#<) pp_state (FreeVar {fv_name}) = pp_state <#< fv_name + (<#<) pp_state (FreeVar {fv_ident}) = pp_state <#< fv_ident (<#<) pp_state (ClassVariable info_ptr) = pp_state <#< "ClassVariable " <#< ptrToInt info_ptr (<#<) pp_state expr = abort ("<#< (Expression) [line 1290]" ) @@ -644,9 +644,9 @@ where instance <#< FunDef where - (<#<) pp_state=:{function_index} {fun_symb,fun_body=TransformedBody {tb_args,tb_rhs},fun_info={fi_free_vars,fi_def_level,fi_calls}} + (<#<) pp_state=:{function_index} {fun_ident,fun_body=TransformedBody {tb_args,tb_rhs},fun_info={fi_free_vars,fi_def_level,fi_calls}} # pp_state - = pp_state <#< "\nFunction: " <#< fun_symb <#< '@' <#< function_index <#< '\n' <#< tb_args <#< '[' <#< fi_calls <#< ']' <#< " = " + = pp_state <#< "\nFunction: " <#< fun_ident <#< '@' <#< function_index <#< '\n' <#< tb_args <#< '[' <#< fi_calls <#< ']' <#< " = " # pp_state = IndentLevelForward pp_state # pp_state @@ -654,10 +654,10 @@ where # pp_state = IndentLevelBackward pp_state = pp_state - (<#<) pp_state=:{function_index} {fun_symb,fun_body=NoBody,fun_type=Yes type} - = pp_state <#< type <#< '\n' <#< fun_symb <#< '.' <#< function_index <#< "Array function\n" - (<#<) pp_state=:{function_index} {fun_symb,fun_body=Expanding vars,fun_type=Yes type} - = pp_state <#< type <#< '\n' <#< fun_symb <#< '.' <#< function_index <#< "Expanding function\n" + (<#<) pp_state=:{function_index} {fun_ident,fun_body=NoBody,fun_type=Yes type} + = pp_state <#< type <#< '\n' <#< fun_ident <#< '.' <#< function_index <#< "Array function\n" + (<#<) pp_state=:{function_index} {fun_ident,fun_body=Expanding vars,fun_type=Yes type} + = pp_state <#< type <#< '\n' <#< fun_ident <#< '.' <#< function_index <#< "Expanding function\n" instance <#< FunCall where @@ -670,8 +670,8 @@ where instance <#< FreeVar where - (<#<) pp_state {fv_name,fv_info_ptr,fv_count} - = pp_state <#< fv_name <#< '.' <#< fv_count <#< '<' <#< ptrToInt fv_info_ptr <#< '>' + (<#<) pp_state {fv_ident,fv_info_ptr,fv_count} + = pp_state <#< fv_ident <#< '.' <#< fv_count <#< '<' <#< ptrToInt fv_info_ptr <#< '>' instance <#< DynamicType where @@ -726,8 +726,8 @@ where instance <#< (TypeDef a) | <#< a where - (<#<) pp_state {td_name, td_args, td_rhs} - = pp_state <#< ":: " <#< td_name <#< ' ' <#< td_args <#< td_rhs + (<#<) pp_state {td_ident, td_args, td_rhs} + = pp_state <#< ":: " <#< td_ident <#< ' ' <#< td_args <#< td_rhs instance <#< TypeRhs where @@ -746,7 +746,7 @@ where instance <#< FieldSymbol where - (<#<) pp_state {fs_name} = pp_state <#< fs_name + (<#<) pp_state {fs_ident} = pp_state <#< fs_ident instance <#< InstanceType where @@ -758,15 +758,15 @@ where instance <#< ConsDef where - (<#<) pp_state {cons_symb,cons_type} = pp_state <#< cons_symb <#< " :: " <#< cons_type + (<#<) pp_state {cons_ident,cons_type} = pp_state <#< cons_ident <#< " :: " <#< cons_type instance <#< SelectorDef where - (<#<) pp_state {sd_symb} = pp_state <#< sd_symb + (<#<) pp_state {sd__ident} = pp_state <#< sd__ident instance <#< ClassDef where - (<#<) pp_state {class_name} = pp_state <#< class_name + (<#<) pp_state {class_ident} = pp_state <#< class_ident instance <#< ClassInstance where @@ -779,7 +779,7 @@ where instance <#< (Module a) | <#< a where - (<#<) pp_state {mod_name,mod_type,mod_defs} = pp_state <#< mod_type <#< mod_name <#< mod_defs + (<#<) pp_state {mod_ident,mod_type,mod_defs} = pp_state <#< mod_type <#< mod_ident <#< mod_defs instance <#< (CollectedDefinitions a b) | <#< a & <#< b where diff --git a/frontend/explicitimports.icl b/frontend/explicitimports.icl index 07bf747..63b1c51 100644 --- a/frontend/explicitimports.icl +++ b/frontend/explicitimports.icl @@ -100,7 +100,7 @@ foldlBelongingSymbols f bs st BS_Constructors constructors -> foldSt (\{ds_ident} st -> f ds_ident st) constructors st BS_Fields fields - -> foldlArraySt (\{fs_name} st -> f fs_name st) fields st + -> foldlArraySt (\{fs_ident} st -> f fs_ident st) fields st BS_Members members -> foldlArraySt (\{ds_ident} st -> f ds_ident st) members st BS_Nothing @@ -228,11 +228,11 @@ solveExplicitImports expl_imp_indices_ikh modules_in_component_set importing_mod decl_kind = STE_Imported STE_Constructor def_mod_index, decl_index = ds_index }, dcl_modules) BS_Fields rt_fields - # {fs_name, fs_index} = rt_fields.[belong_nr] - ({sd_symb}, dcl_modules) + # {fs_ident, fs_index} = rt_fields.[belong_nr] + ({sd__ident}, dcl_modules) = dcl_modules![def_mod_index].dcl_common.com_selector_defs.[fs_index] - -> (Declaration { decl_ident = fs_name, decl_pos = position, - decl_kind = STE_Imported (STE_Field sd_symb) def_mod_index, + -> (Declaration { decl_ident = fs_ident, decl_pos = position, + decl_kind = STE_Imported (STE_Field sd__ident) def_mod_index, decl_index = fs_index }, dcl_modules) BS_Members class_members # {ds_ident, ds_index} = class_members.[belong_nr] @@ -247,7 +247,7 @@ solveExplicitImports expl_imp_indices_ikh modules_in_component_set importing_mod BS_Constructors constructors -> ([ds_ident \\ {ds_ident}<-constructors], dcl_modules) BS_Fields rt_fields - -> ([fs_name \\ {fs_name}<-:rt_fields], dcl_modules) + -> ([fs_ident \\ {fs_ident}<-:rt_fields], dcl_modules) BS_Members class_members # (STE_Imported _ def_mod_index) = decl_kind ({class_members}, dcl_modules) @@ -740,26 +740,26 @@ instance check_completeness SelectorDef where = check_completeness sd_type cci ccs instance check_completeness SymbIdent where - check_completeness {symb_name, symb_kind} cci ccs + check_completeness {symb_ident, symb_kind} cci ccs = case symb_kind of SK_Constructor _ - -> check_whether_ident_is_imported symb_name STE_Constructor cci ccs + -> check_whether_ident_is_imported symb_ident STE_Constructor cci ccs SK_Function global_index - -> check_completeness_for_function symb_name global_index cci ccs + -> check_completeness_for_function symb_ident global_index cci ccs SK_DclMacro global_index - -> check_completeness_for_macro symb_name global_index cci ccs + -> check_completeness_for_macro symb_ident global_index cci ccs SK_LocalDclMacroFunction global_index - -> check_completeness_for_local_dcl_macro symb_name global_index cci ccs + -> check_completeness_for_local_dcl_macro symb_ident global_index cci ccs SK_LocalMacroFunction function_index - -> check_completeness_for_local_macro_function symb_name function_index cci ccs + -> check_completeness_for_local_macro_function symb_ident function_index cci ccs SK_OverloadedFunction global_index - -> check_whether_ident_is_imported symb_name STE_Member cci ccs + -> check_whether_ident_is_imported symb_ident STE_Member cci ccs where - check_completeness_for_function symb_name {glob_object,glob_module} cci ccs + check_completeness_for_function symb_ident {glob_object,glob_module} cci ccs | glob_module<>cci.box_cci.cci_main_dcl_module_n // the function that is referred from within a macro is a DclFunction // -> must be global -> has to be imported - = check_whether_ident_is_imported symb_name (STE_FunctionOrMacro []) cci ccs + = check_whether_ident_is_imported symb_ident (STE_FunctionOrMacro []) cci ccs // otherwise the function was defined locally in a macro // it is not a consequence, but it's type and body are consequences ! #! (already_visited, ccs) = ccs!box_ccs.ccs_set_of_visited_icl_funs.[glob_object] @@ -769,12 +769,12 @@ instance check_completeness SymbIdent where # (fun_def, ccs) = ccs!box_ccs.ccs_icl_functions.[glob_object] = check_completeness fun_def cci ccs - check_completeness_for_macro symb_name global_index cci ccs + check_completeness_for_macro symb_ident global_index cci ccs | global_index.glob_module<>cci.box_cci.cci_main_dcl_module_n - = check_whether_ident_is_imported symb_name (STE_DclMacroOrLocalMacroFunction []) cci ccs - = check_completeness_for_local_dcl_macro symb_name global_index cci ccs + = check_whether_ident_is_imported symb_ident (STE_DclMacroOrLocalMacroFunction []) cci ccs + = check_completeness_for_local_dcl_macro symb_ident global_index cci ccs - check_completeness_for_local_dcl_macro symb_name {glob_module,glob_object} cci ccs + check_completeness_for_local_dcl_macro symb_ident {glob_module,glob_object} cci ccs | size ccs.box_ccs.ccs_set_of_visited_macros.[glob_module]==0 // #! n_macros_in_dcl_module=size ccs.box_ccs.ccs_macro_defs.[glob_module] # (n_macros_in_dcl_module,ccs) = get_n_macros_in_dcl_module ccs glob_module @@ -793,7 +793,7 @@ instance check_completeness SymbIdent where # (macro_def, ccs) = ccs!box_ccs.ccs_macro_defs.[glob_module,glob_object] = check_completeness macro_def cci ccs - check_completeness_for_local_macro_function symb_name glob_object cci ccs + check_completeness_for_local_macro_function symb_ident glob_object cci ccs // otherwise the function was defined locally in a macro // it is not a consequence, but it's type and body are consequences ! | ccs.box_ccs.ccs_set_of_visited_icl_funs.[glob_object] @@ -814,12 +814,12 @@ instance check_completeness TransformedBody where = check_completeness tb_rhs cci ccs instance check_completeness Type where - check_completeness (TA {type_name} arguments) cci ccs + check_completeness (TA {type_ident} arguments) cci ccs = check_completeness arguments cci - (check_whether_ident_is_imported type_name STE_Type cci ccs) - check_completeness (TAS {type_name} arguments _) cci ccs + (check_whether_ident_is_imported type_ident STE_Type cci ccs) + check_completeness (TAS {type_ident} arguments _) cci ccs = check_completeness arguments cci - (check_whether_ident_is_imported type_name STE_Type cci ccs) + (check_whether_ident_is_imported type_ident STE_Type cci ccs) check_completeness (l --> r) cci ccs = check_completeness l cci (check_completeness r cci ccs) diff --git a/frontend/frontend.icl b/frontend/frontend.icl index bd7d111..4915ffa 100644 --- a/frontend/frontend.icl +++ b/frontend/frontend.icl @@ -326,7 +326,7 @@ where | show_types = show_component funs show_types fun_defs (file <<< fun_def.fun_type <<< '\n' <<< fun_def) = show_component funs show_types fun_defs (file <<< fun_def) -// = show_component funs show_types fun_defs (file <<< fun_def.fun_symb) +// = show_component funs show_types fun_defs (file <<< fun_def.fun_ident) //show_components comps fun_defs = map (show_component fun_defs) comps @@ -347,7 +347,7 @@ where # (fun_def, fun_defs) = fun_defs![fun] # properties = { form_properties = cAttributed bitor cAnnotated, form_attr_position = No } (Yes ftype) = fun_def.fun_type - = show_types funs fun_defs (file <<< fun_def.fun_symb <<< " :: " <:: (properties, ftype, No) <<< '\n' ) + = show_types funs fun_defs (file <<< fun_def.fun_ident <<< " :: " <:: (properties, ftype, No) <<< '\n' ) showDclModules :: !u:{#DclModule} !*File -> (!u:{#DclModule}, !*File) showDclModules dcl_mods file @@ -372,8 +372,8 @@ where | otherwise # file = show_dcl_function dcl_functions.[fun_index] file = show_dcl_functions (inc fun_index) dcl_functions file - show_dcl_function {ft_symb, ft_type} file - = file <<< ft_symb <<< " :: " <<< ft_type <<< "\n" + show_dcl_function {ft_ident, ft_type} file + = file <<< ft_ident <<< " :: " <<< ft_type <<< "\n" instance == ListTypesKind where (==) ListTypesNone ListTypesNone diff --git a/frontend/generics.icl b/frontend/generics.icl index 28c927a..9162aad 100644 --- a/frontend/generics.icl +++ b/frontend/generics.icl @@ -385,7 +385,7 @@ where = (maybe_td_index, instance_defs, gs) determine_type_def_index - (TA {type_index, type_name} _) + (TA {type_index, type_ident} _) instance_def=:{ins_generate, ins_ident, ins_pos} is_partial gs_modules gs_error @@ -397,7 +397,7 @@ where = ([type_index], instance_def, gs_modules, gs_error) | supportPartialInstances && is_partial = ([type_index], {instance_def & ins_partial = True}, gs_modules, gs_error) - //---> ("collected partial instance type", type_name, type_index) + //---> ("collected partial instance type", type_ident, type_index) | otherwise = ([], instance_def, gs_modules, gs_error) determine_td_index (RecordType _) gs_modules gs_error @@ -405,7 +405,7 @@ where = ([type_index], instance_def, gs_modules, gs_error) | supportPartialInstances && is_partial = ([type_index], {instance_def & ins_partial = True}, gs_modules, gs_error) - //---> ("collected partial instance type", type_name, type_index) + //---> ("collected partial instance type", type_ident, type_index) | otherwise = ([], instance_def, gs_modules, gs_error) determine_td_index (SynType _) gs_modules gs_error @@ -543,7 +543,7 @@ where {gs & gs_modules = gs_modules, gs_heaps = gs_heaps, gs_error = gs_error} check_generic - {gen_cons_ptr, gen_name, gen_pos} + {gen_cons_ptr, gen_ident, gen_pos} gs_heaps=:{hp_type_heaps=hp_type_heaps=:{th_vars}} gs_error # (info, th_vars) = readPtr gen_cons_ptr th_vars @@ -551,7 +551,7 @@ where TVI_ConsInstance _ -> gs_error _ - -> reportError gen_name gen_pos "instance on CONS must be provided" gs_error + -> reportError gen_ident gen_pos "instance on CONS must be provided" gs_error = ({gs_heaps & hp_type_heaps = {hp_type_heaps & th_vars = th_vars}}, gs_error) @@ -644,7 +644,7 @@ where = (expr, heaps) get_cons_fun - {gen_cons_ptr, gen_pos, gen_name} + {gen_cons_ptr, gen_pos, gen_ident} gs=:{gs_heaps=gs_heaps=:{hp_type_heaps=hp_type_heaps=:{th_vars}}, gs_error} # (info, th_vars) = readPtr gen_cons_ptr th_vars # gs_heaps = { gs_heaps & hp_type_heaps = {hp_type_heaps & th_vars = th_vars }} @@ -652,7 +652,7 @@ where TVI_ConsInstance fun_def_sym -> (fun_def_sym, gs_error) TVI_Empty - -> (EmptyDefinedSymbol, reportError gen_name gen_pos "no CONS instance provided" gs_error) + -> (EmptyDefinedSymbol, reportError gen_ident gen_pos "no CONS instance provided" gs_error) = (fun_def_sym, {gs & gs_heaps = gs_heaps, gs_error = gs_error}) set_cons_fun @@ -808,12 +808,12 @@ where // their mapping is identity = ([], gs) collect_in_type_app - {type_index=type_index=:{glob_module, glob_object}, type_name} + {type_index=type_index=:{glob_module, glob_object}, type_ident} gs=:{gs_gtd_infos, gs_td_infos, gs_modules} # (gtd_info, gs_gtd_infos) = gs_gtd_infos ! [glob_module, glob_object] | toBool gtd_info // already marked = ([], {gs & gs_gtd_infos = gs_gtd_infos}) - //---> ("already marked type", type_name, type_index) + //---> ("already marked type", type_ident, type_index) | otherwise // not yet marked # gs_gtd_infos = {gs_gtd_infos & [glob_module, glob_object] = GTDI_Generic EmptyGenericType} # (td_info, gs_td_infos) = gs_td_infos ! [glob_module, glob_object] @@ -822,7 +822,7 @@ where # (td_indexes1, gs) = collect_in_type_def_rhs glob_module type_def gs # td_indexes2 = [(type_index, td_info.tdi_group_nr)] = (merge_td_indexes td_indexes1 td_indexes2, gs) - //---> ("mark type", type_name, type_index) + //---> ("mark type", type_ident, type_index) collect_in_type (arg_type --> res_type) gs #! (td_indexes1, gs) = collect_in_atype arg_type gs @@ -857,13 +857,13 @@ where = collect_in_conses mod [rt_constructor] gs collect_in_type_def_rhs mod {td_rhs=(SynType {at_type})} gs = collect_in_type at_type gs - collect_in_type_def_rhs mod {td_rhs=(AbstractType _), td_name, td_pos} gs=:{gs_error} + collect_in_type_def_rhs mod {td_rhs=(AbstractType _), td_ident, td_pos} gs=:{gs_error} #! gs_error = checkErrorWithIdentPos - (newPosition td_name td_pos) + (newPosition td_ident td_pos) "cannot build generic type representation for an abstract type" gs_error = ([], {gs & gs_error = gs_error}) - //= ([], {gs & gs_error = checkWarning td_name "abstract data type" gs_error}) + //= ([], {gs & gs_error = checkWarning td_ident "abstract data type" gs_error}) collect_in_conses :: !Index ![DefinedSymbol] !*GenericState -> (![(Global Index, Int)], !*GenericState) @@ -943,23 +943,23 @@ where # (iso_fun_index, iso_group_index, gs) = newFunAndGroupIndex gs # {gs_modules} = gs - # (type_def=:{td_name}, gs_modules) = getTypeDef module_index type_def_index gs_modules + # (type_def=:{td_ident}, gs_modules) = getTypeDef module_index type_def_index gs_modules # gs = {gs & gs_modules = gs_modules} # iso_def_sym = { - ds_ident = {id_name="iso_"+++type_def.td_name.id_name, id_info = nilPtr }, + ds_ident = {id_name="iso_"+++type_def.td_ident.id_name, id_info = nilPtr }, ds_index = iso_fun_index, ds_arity = 0 } # from_def_sym = { - ds_ident = {id_name="iso_from_generic_to_"+++type_def.td_name.id_name, id_info = nilPtr }, + ds_ident = {id_name="iso_from_generic_to_"+++type_def.td_ident.id_name, id_info = nilPtr }, ds_index = from_fun_index, ds_arity = 1 } # to_def_sym = { - ds_ident = {id_name="iso_to_generic_from_"+++type_def.td_name.id_name, id_info = nilPtr }, + ds_ident = {id_name="iso_to_generic_from_"+++type_def.td_ident.id_name, id_info = nilPtr }, ds_index = to_fun_index, ds_arity = 1 } @@ -990,7 +990,7 @@ where # (type_fun_index, group_index, gs) = newFunAndGroupIndex gs # type_fun_sym = - { ds_ident = makeIdent ("type_info_" +++ type_def.td_name.id_name) + { ds_ident = makeIdent ("type_info_" +++ type_def.td_ident.id_name) , ds_index = type_fun_index , ds_arity = 0 } @@ -1018,15 +1018,15 @@ where = ([fi:fis], [fd:fds], gs) build_cons_info {ds_index,ds_arity} cons_num type_info_def_sym group_index common_defs gs=:{gs_main_dcl_module_n} - # {cons_symb, cons_pos, cons_type} = common_defs.com_cons_defs.[ds_index] + # {cons_ident, cons_pos, cons_type} = common_defs.com_cons_defs.[ds_index] # (fun_index, gs) = newFunIndex gs # def_sym = - { ds_ident = makeIdent ("cons_info_" +++ cons_symb.id_name) + { ds_ident = makeIdent ("cons_info_" +++ cons_ident.id_name) , ds_index = fun_index , ds_arity = 0 } # {gs_modules,gs_heaps, gs_predefs, gs_main_dcl_module_n} = gs - # cons_name_expr = makeStringExpr ("\""+++cons_symb.id_name+++"\"") gs_predefs + # cons_name_expr = makeStringExpr ("\""+++cons_ident.id_name+++"\"") gs_predefs # cons_arity_expr = makeIntExpr ds_arity # cons_num_expr = makeIntExpr cons_num # (cons_type_expr, gs_heaps) = buildFunApp gs_main_dcl_module_n type_info_def_sym [] gs_heaps @@ -1091,9 +1091,9 @@ where = (type_app_expr, { gs & gs_heaps = gs_heaps}) - build_type_info {at_type=TA {type_name,type_arity} ts} gs + build_type_info {at_type=TA {type_ident,type_arity} ts} gs # (arg_exprs, gs) = build_type_infos ts gs - = build_type_def_app type_name.id_name type_arity [] [] arg_exprs gs + = build_type_def_app type_ident.id_name type_arity [] [] arg_exprs gs build_type_info {at_type=arg --> res} gs # (arg_expr, gs) = build_type_info arg gs @@ -1114,8 +1114,8 @@ where = build_type_def_app name 0 [] [] [] gs - build_type_info {at_type=TV {tv_name}} gs=:{gs_heaps, gs_predefs} - # name_expr = makeStringExpr ("\"" +++ tv_name.id_name +++ "\"") gs_predefs + build_type_info {at_type=TV {tv_ident}} gs=:{gs_heaps, gs_predefs} + # name_expr = makeStringExpr ("\"" +++ tv_ident.id_name +++ "\"") gs_predefs # (expr, gs_heaps) = buildPredefConsApp PD_ConsTypeVar [ name_expr ] gs_predefs gs_heaps = (expr, {gs & gs_heaps = gs_heaps}) @@ -1125,15 +1125,15 @@ where = (expr, {gs & gs_heaps = gs_heaps}) build_typedef_info - {td_pos,td_name, td_args} + {td_pos,td_ident, td_args} type_info_def_sym group_index cons_info_def_syms gs=:{gs_main_dcl_module_n} - # type_vars = [ atv.atv_variable.tv_name.id_name \\ atv <- td_args] + # type_vars = [ atv.atv_variable.tv_ident.id_name \\ atv <- td_args] # (body_expr, gs) = build_type_def - td_name.id_name type_info_def_sym.ds_arity type_vars cons_info_def_syms gs + td_ident.id_name type_info_def_sym.ds_arity type_vars cons_info_def_syms gs # fun_def = makeFunction type_info_def_sym group_index [] body_expr No [] gs_main_dcl_module_n td_pos = (fun_def, gs) @@ -1164,22 +1164,22 @@ where # (rec_fun_index, gs) = newFunIndex gs # (gs=:{gs_gtd_infos, gs_modules}) = gs - # (type_def=:{td_name, td_arity}, gs_modules) = getTypeDef glob_module glob_object gs_modules + # (type_def=:{td_ident, td_arity}, gs_modules) = getTypeDef glob_module glob_object gs_modules # (GTDI_Generic gt, gs_gtd_infos) = gs_gtd_infos ! [glob_module, glob_object] # gtd_info = GTDI_Generic {gt & gtr_isomap_from = { - ds_ident = {id_name="isomap_from_"+++td_name.id_name, id_info=nilPtr}, + ds_ident = {id_name="isomap_from_"+++td_ident.id_name, id_info=nilPtr}, ds_index = from_fun_index, ds_arity = (td_arity + 1) }, gtr_isomap_to = { - ds_ident = {id_name="isomap_to_"+++td_name.id_name, id_info=nilPtr}, + ds_ident = {id_name="isomap_to_"+++td_ident.id_name, id_info=nilPtr}, ds_index = to_fun_index, ds_arity = (td_arity + 1) }, gtr_isomap = { - ds_ident = {id_name="isomap_"+++td_name.id_name, id_info=nilPtr}, + ds_ident = {id_name="isomap_"+++td_ident.id_name, id_info=nilPtr}, ds_index = rec_fun_index, ds_arity = td_arity } @@ -1208,7 +1208,7 @@ where # (group_index, gs) = get_group module_index type_def_index gs # {gs_modules, gs_gtd_infos} = gs - # (type_def=:{td_name}, gs_modules) = getTypeDef module_index type_def_index gs_modules + # (type_def=:{td_ident}, gs_modules) = getTypeDef module_index type_def_index gs_modules # (GTDI_Generic {gtr_isomap, gtr_isomap_to, gtr_isomap_from}, gs_gtd_infos) = gs_gtd_infos![module_index, type_def_index] @@ -1225,14 +1225,14 @@ where # funs = [ (from_fun_index, from_fun_def), (to_fun_index, to_fun_def), (rec_fun_index, rec_fun_def) ] = (funs, gs) //---> from_fun_def - //---> ("build isomap for", td_name, module_index, type_def_index) + //---> ("build isomap for", td_ident, module_index, type_def_index) collect_groups :: !Index ![(Index, FunDef)] !*{[Index]} -> !*{[Index]} collect_groups first_group_index [] groups = groups - collect_groups first_group_index [(fun_index, fun=:{fun_symb, fun_info={fi_group_index}}):funs] groups + collect_groups first_group_index [(fun_index, fun=:{fun_ident, fun_info={fi_group_index}}):funs] groups # (group, groups) = groups ! [fi_group_index - first_group_index] # groups = {groups & [fi_group_index - first_group_index] = [fun_index:group]} - //---> ("add fun " +++ fun_symb.id_name +++ " "+++ toString fun_index +++ + //---> ("add fun " +++ fun_ident.id_name +++ " "+++ toString fun_index +++ // " to group " +++ toString fi_group_index) = collect_groups first_group_index funs groups @@ -1297,10 +1297,10 @@ where = (new_funs ++ funs, new_groups ++ groups, generic_defs, gs) build_isomap module_index generic_index generic_defs gs - # (generic_def=:{gen_name, gen_type}, generic_defs) = generic_defs ! [generic_index] + # (generic_def=:{gen_ident, gen_type}, generic_defs) = generic_defs ! [generic_index] # (fun_index, group_index, gs) = newFunAndGroupIndex gs # def_sym = { - ds_ident = {id_name="isomap_"+++gen_name.id_name, id_info = nilPtr}, + ds_ident = {id_name="isomap_"+++gen_ident.id_name, id_info = nilPtr}, ds_index = fun_index, ds_arity = gen_type.gt_arity } @@ -1460,7 +1460,7 @@ where } = (ins_fun_def, {gs & gs_heaps = gs_heaps}) - //---> ("created generic alterntaive for " +++ ins_fun_def.fun_symb.id_name) + //---> ("created generic alterntaive for " +++ ins_fun_def.fun_ident.id_name) move_instance instance_def=:{ins_members, ins_pos} gs=:{gs_main_dcl_module_n} # (new_fun_index, new_fun_group, gs=:{gs_fun_defs, gs_predefs, gs_heaps}) @@ -1481,9 +1481,9 @@ where #! (undef_expr, gs_heaps) = buildUndefFunApp [] gs_predefs gs_heaps #! (arg_vars, gs_heaps) = mapSt buildFreeVar0 ["v" +++ toString i \\ i <- [1..ins_fun_def.fun_arity]] gs_heaps - # {fun_symb, fun_arity, fun_info, fun_type, fun_pos} = ins_fun_def + # {fun_ident, fun_arity, fun_info, fun_type, fun_pos} = ins_fun_def #! dummy_def_sym = - { ds_ident = fun_symb + { ds_ident = fun_ident , ds_arity = fun_arity , ds_index = ins_fun_index } @@ -1597,14 +1597,14 @@ where # gs = {gs & gs_modules=gs_modules, gs_td_infos = gs_td_infos, gs_heaps = gs_heaps} # (fun_index, group_index, gs) = newFunAndGroupIndex gs # fun_def_sym = { - ds_ident = kind_star_class_def.class_name, // kind star name + ds_ident = kind_star_class_def.class_ident, // kind star name ds_index = fun_index, ds_arity = member_def.me_type.st_arity } //# (fun_def, gs) = build_dummy_instance fun_def_sym group_index gs # generic_def_sym = { - ds_ident=generic_def.gen_name, + ds_ident=generic_def.gen_ident, ds_index=ins_generic.glob_object, ds_arity=0 } @@ -1614,7 +1614,7 @@ where # new_instance_def = { ins_class = {glob_module = ins_generic.glob_module, glob_object = kind_star_class_def_sym}, - ins_ident = kind_star_class_def.class_name, + ins_ident = kind_star_class_def.class_ident, ins_type = new_ins_type, ins_members = {fun_def_sym}, ins_specials = SP_None, @@ -1690,7 +1690,7 @@ where build_type_var name heaps=:{hp_type_heaps=hp_type_heaps=:{th_vars}} # (tv_info_ptr, th_vars) = newPtr TVI_Empty th_vars # type_var = { - tv_name = {id_name = name, id_info = nilPtr}, + tv_ident = {id_name = name, id_info = nilPtr}, tv_info_ptr = tv_info_ptr } = ( type_var, {heaps & hp_type_heaps = {hp_type_heaps & th_vars = th_vars}}) @@ -1852,8 +1852,8 @@ kindOfType _ td_infos buildClassDef :: !Index !Index !Index !GenericDef !TypeKind !*GenericState -> (!ClassDef, !MemberDef!, !GenericDef, *GenericState) -buildClassDef module_index class_index member_index generic_def=:{gen_name, gen_classes} kind gs=:{gs_heaps} - #! ident = makeIdent (gen_name.id_name +++ ":" +++ (toString kind)) +buildClassDef module_index class_index member_index generic_def=:{gen_ident, gen_classes} kind gs=:{gs_heaps} + #! ident = makeIdent (gen_ident.id_name +++ ":" +++ (toString kind)) #! class_ds={ds_ident=ident, ds_index=class_index, ds_arity=0} #! (class_var, gs_heaps) = build_class_var gs_heaps #! (member_def, class_contexts, gs_heaps) = build_member module_index class_index member_index class_var class_ds generic_def gs_heaps @@ -1882,7 +1882,7 @@ where //#! member_type = { member_type & st_context = [type_context : gen_type.gt_type.st_context] } #! member_type = { member_type & st_context = [type_context : member_type.st_context] } #! member_def = { - me_symb = ds_ident, // same name as class + me_ident = ds_ident, // same name as class me_class = {glob_module = module_index, glob_object = class_index}, me_offset = 0, me_type = member_type, @@ -1904,7 +1904,7 @@ where ds_index = NoIndex/*index in the type def table, filled in later*/ } #! class_def = { - class_name = ident, + class_ident = ident, class_arity = 1, class_args = [class_var], class_context = class_contexts, @@ -2057,7 +2057,7 @@ currySymbolType4 st=:{st_args, st_result, st_attr_env, st_attr_vars} attr_var_n // specialize generic (kind-indexed) type for a kind specializeGenericType :: !GenericDef !TypeKind !*TypeHeaps -> (!SymbolType, ![ATypeVar], ![AttributeVar], !*TypeHeaps) -specializeGenericType generic_def=:{gen_name,gen_type} kind th +specializeGenericType generic_def=:{gen_ident,gen_type} kind th //#! th = th ---> ("specializeSymbolType", kind, gen_type.gt_type) @@ -2201,16 +2201,16 @@ where #! (attr, th_attrs) = fresh_attr atv_attribute postfix th_attrs = ({agv & atv_attribute = attr, atv_variable = tv}, {th & th_vars = th_vars, th_attrs = th_attrs}) where - fresh_tv {tv_name, tv_info_ptr} postfix th_vars - #! name = makeIdent (tv_name.id_name +++ postfix) + fresh_tv {tv_ident, tv_info_ptr} postfix th_vars + #! name = makeIdent (tv_ident.id_name +++ postfix) #! (tv, th_vars) = freshTypeVar name th_vars #! th_vars = th_vars <:= (tv_info_ptr, TVI_Type (TV tv)) = (tv, th_vars) fresh_attr (TA_Unique) postfix th_attrs = (TA_Unique, th_attrs) fresh_attr (TA_Multi) postfix th_attrs = (TA_Multi, th_attrs) - fresh_attr (TA_Var av=:{av_name, av_info_ptr}) postfix th_attrs - #! (fresh_av, th_attrs) = freshAttrVar (makeIdent (av_name.id_name+++postfix)) th_attrs + fresh_attr (TA_Var av=:{av_ident, av_info_ptr}) postfix th_attrs + #! (fresh_av, th_attrs) = freshAttrVar (makeIdent (av_ident.id_name+++postfix)) th_attrs #! attr = TA_Var fresh_av #! th_attrs = th_attrs <:= (av_info_ptr, AVI_Attr attr) = (attr, th_attrs) @@ -2219,7 +2219,7 @@ where = {th & th_attrs = th_attrs <:= (av_info_ptr, AVI_Attr (TA_Var av))} buildMemberType2 :: !GenericDef !TypeKind !TypeVar !*TypeHeaps !*VarHeap -> (!SymbolType, ![TypeContext], !*TypeHeaps, !*VarHeap) -buildMemberType2 generic_def=:{gen_name,gen_type} kind class_var th var_heap +buildMemberType2 generic_def=:{gen_ident,gen_type} kind class_var th var_heap # (st, agvs, gavs, th) = specializeGenericType generic_def kind th @@ -2351,7 +2351,7 @@ where buildMemberType :: !GenericDef !TypeKind !TypeVar !*TypeHeaps -> (!SymbolType, !*TypeHeaps) -buildMemberType generic_def=:{gen_name,gen_type} kind class_var th +buildMemberType generic_def=:{gen_ident,gen_type} kind class_var th // = abort "generics; buildMemberType" #! (gen_type, th) = freshGenericType gen_type th @@ -2387,7 +2387,7 @@ buildMemberType generic_def=:{gen_name,gen_type} kind class_var th } = (st, th) - //---> ("member type", gen_name, kind, st) + //---> ("member type", gen_ident, kind, st) where @@ -2486,8 +2486,8 @@ where // replace all generic variables with fresh variables #! (tvs, th_vars) = mapSt build_subst gt_vars th_vars with - build_subst gv=:{tv_name,tv_info_ptr} th_vars - #! name = makeIdent (tv_name.id_name +++ postfix) + build_subst gv=:{tv_ident,tv_info_ptr} th_vars + #! name = makeIdent (tv_ident.id_name +++ postfix) #! (tv, th_vars) = freshTypeVar name th_vars #! th_vars = th_vars <:= (tv_info_ptr, TVI_Type (TV tv)) = (tv, th_vars) @@ -2503,8 +2503,8 @@ where with build_subst {atv_attribute=TA_Unique} st = (TA_Unique, st) build_subst {atv_attribute=TA_Multi} st = (TA_Multi, st) - build_subst {atv_attribute=TA_Var {av_name, av_info_ptr}} (avs, th_attrs) - #! (fresh_av, th_attrs) = freshAttrVar (makeIdent (av_name.id_name+++postfix)) th_attrs + build_subst {atv_attribute=TA_Var {av_ident, av_info_ptr}} (avs, th_attrs) + #! (fresh_av, th_attrs) = freshAttrVar (makeIdent (av_ident.id_name+++postfix)) th_attrs #! attr = TA_Var fresh_av #! th_attrs = th_attrs <:= (av_info_ptr, AVI_Attr attr) = (attr, ([fresh_av:avs], th_attrs)) @@ -2521,7 +2521,7 @@ where buildGenericRepType :: !Index !Index !*GenericState -> (AType, !*GenericState) buildGenericRepType module_index td_index gs=:{gs_modules, gs_predefs, gs_error} - # (type_def=:{td_name}, gs_modules) = getTypeDef module_index td_index gs_modules + # (type_def=:{td_ident}, gs_modules) = getTypeDef module_index td_index gs_modules # (common_defs, gs_modules) = gs_modules ! [module_index] # (atype, gs_error) = build_type module_index type_def gs_predefs common_defs gs_error = (atype, {gs & gs_modules = gs_modules, gs_error = gs_error}) @@ -2553,9 +2553,9 @@ where = (type, error) // is that correct ??? build_type - td_module td=:{td_rhs=(AbstractType _), td_name, td_arity, td_args, td_pos} + td_module td=:{td_rhs=(AbstractType _), td_ident, td_arity, td_args, td_pos} predefs common_defs error - #! error = checkErrorWithIdentPos (newPosition td_name td_pos) "cannot build generic type repesentation for an abstract type" error + #! error = checkErrorWithIdentPos (newPosition td_ident td_pos) "cannot build generic type repesentation for an abstract type" error = (makeAType TE TA_None, error) buildIsoRecord :: !DefinedSymbol !Int !DefinedSymbol !DefinedSymbol !*GenericState @@ -2574,7 +2574,7 @@ buildIsoTo :: !DefinedSymbol !Int !Int !CheckedTypeDef ![DefinedSymbol] !*Generi -> (!FunDef, !*GenericState) buildIsoTo def_sym group_index type_def_mod - type_def=:{td_rhs, td_name, td_index, td_pos} + type_def=:{td_rhs, td_ident, td_index, td_pos} cons_infos gs=:{gs_heaps,gs_main_dcl_module_n} # (arg_expr, arg_var, gs_heaps) = buildVarExpr "x" gs_heaps @@ -2600,10 +2600,10 @@ where = build_body1 type_def_mod type_def_index [rt_constructor] cons_infos arg_expr gs build_body type_def_mod type_def_index (AbstractType _) cons_infos arg_expr gs=:{gs_error} - #! gs_error = checkErrorWithIdentPos (newPosition td_name td_pos) "cannot build isomorphisms for an abstract type" gs_error + #! gs_error = checkErrorWithIdentPos (newPosition td_ident td_pos) "cannot build isomorphisms for an abstract type" gs_error = (EE, [], {gs & gs_error = gs_error}) build_body type_def_mod type_def_index (SynType _) cons_infos arg_expr gs=:{gs_error} - #! gs_error = checkErrorWithIdentPos (newPosition td_name td_pos) "cannot build isomorphisms for a synonym type" gs_error + #! gs_error = checkErrorWithIdentPos (newPosition td_ident td_pos) "cannot build isomorphisms for a synonym type" gs_error = (EE, [], {gs & gs_error = gs_error}) build_body1 type_def_mod type_def_index cons_def_syms cons_infos arg_expr gs @@ -2676,7 +2676,7 @@ buildIsoFrom :: !DefinedSymbol !Int !Int !CheckedTypeDef !*GenericState -> (!FunDef, !*GenericState) buildIsoFrom def_sym group_index type_def_mod - type_def=:{td_rhs, td_name, td_index, td_pos} + type_def=:{td_rhs, td_ident, td_index, td_pos} gs=:{gs_predefs, gs_heaps, gs_error,gs_main_dcl_module_n} #! (body_expr, free_vars, gs_heaps, gs_error) = build_body type_def_mod td_rhs gs_predefs gs_heaps gs_error | not gs_error.ea_ok @@ -2693,10 +2693,10 @@ where build_body type_def_mod (RecordType {rt_constructor}) predefs heaps error = build_sum type_def_mod [rt_constructor] predefs heaps error build_body type_def_mod (AbstractType _) predefs heaps error - #! error = checkErrorWithIdentPos (newPosition td_name td_pos) "cannot build isomorphisms for an abstract type" error + #! error = checkErrorWithIdentPos (newPosition td_ident td_pos) "cannot build isomorphisms for an abstract type" error = (EE, [], heaps, error) build_body type_def_mod (SynType _) predefs heaps error - #! error = checkErrorWithIdentPos (newPosition td_name td_pos) "cannot build isomorphisms for a synonym type" error + #! error = checkErrorWithIdentPos (newPosition td_ident td_pos) "cannot build isomorphisms for a synonym type" error = (EE, [], heaps, error) build_sum :: !Index [DefinedSymbol] !PredefinedSymbols !*Heaps !*ErrorAdmin @@ -2760,7 +2760,7 @@ buildIsomapFromTo :: !IsoDirection !DefinedSymbol !Int !Int !Int !*GenericState buildIsomapFromTo iso_dir def_sym group_index type_def_mod type_def_index gs=:{gs_heaps, gs_modules,gs_main_dcl_module_n} - #! (type_def=:{td_name, td_index, td_arity, td_pos}, gs_modules) + #! (type_def=:{td_ident, td_index, td_arity, td_pos}, gs_modules) = getTypeDef type_def_mod type_def_index gs_modules #! arg_names = [ "i" +++ toString n \\ n <- [1 .. td_arity]] #! (isomap_arg_vars, gs_heaps) = buildFreeVars arg_names gs_heaps @@ -2772,7 +2772,7 @@ buildIsomapFromTo #! (fun_type, gs) = build_type1 iso_dir type_def_mod type_def_index gs #! fun_def = makeFunction def_sym group_index (isomap_arg_vars ++ [arg_var]) body_expr (Yes fun_type) free_vars gs_main_dcl_module_n td_pos = (fun_def, def_sym.ds_index, gs) - //---> ("isomap from/to", td_name, fun_def) + //---> ("isomap from/to", td_ident, fun_def) where build_body :: !IsoDirection !Int !Int !CheckedTypeDef !Expression ![FreeVar] !*GenericState -> (Expression, [FreeVar], !*GenericState) @@ -2784,18 +2784,18 @@ where build_body iso_dir type_def_mod type_def_index - type_def=:{td_rhs=(AbstractType _),td_name, td_pos} arg_expr isomap_arg_vars gs=:{gs_error} + type_def=:{td_rhs=(AbstractType _),td_ident, td_pos} arg_expr isomap_arg_vars gs=:{gs_error} #! gs_error = checkErrorWithIdentPos - (newPosition td_name td_pos) + (newPosition td_ident td_pos) "cannot build map function for an abstract type" gs_error = (EE, [], {gs & gs_error = gs_error}) build_body iso_dir type_def_mod type_def_index - type_def=:{td_rhs=(SynType _), td_name, td_pos} arg_expr isomap_arg_vars gs=:{gs_error} + type_def=:{td_rhs=(SynType _), td_ident, td_pos} arg_expr isomap_arg_vars gs=:{gs_error} #! gs_error = checkErrorWithIdentPos - (newPosition td_name td_pos) + (newPosition td_ident td_pos) "cannot build map function for a synonym type" gs_error = (EE, [], {gs & gs_error = gs_error}) @@ -2847,9 +2847,9 @@ where build_cons_arg :: !IsoDirection !AType !FreeVar ![FreeVar] !CheckedTypeDef !*GenericState -> (!Expression, !*GenericState) - build_cons_arg iso_dir type cons_arg_var fun_vars type_def=:{td_args, td_name, td_pos} gs + build_cons_arg iso_dir type cons_arg_var fun_vars type_def=:{td_args, td_ident, td_pos} gs #! type_def_args = [atv_variable \\ {atv_variable} <- td_args] - #! (iso_expr, gs) = buildIsomapExpr type type_def_args fun_vars td_name td_pos gs + #! (iso_expr, gs) = buildIsomapExpr type type_def_args fun_vars td_ident td_pos gs #! {gs_heaps, gs_predefs} = gs #! sel_expr = case iso_dir of IsoTo -> buildIsoToSelectionExpr iso_expr gs_predefs @@ -2885,14 +2885,14 @@ where iso_dir module_index type_def_index gs=:{gs_heaps, gs_modules, gs_predefs} - #! ({td_arity, td_name}, gs_modules) = getTypeDef module_index type_def_index gs_modules + #! ({td_arity, td_ident}, gs_modules) = getTypeDef module_index type_def_index gs_modules #! (tvs1, gs_heaps) = mapSt (\n->build_type_var ("a"+++toString n)) [1..td_arity] gs_heaps #! (tvs2, gs_heaps) = mapSt (\n->build_type_var ("b"+++toString n)) [1..td_arity] gs_heaps #! (iso_args) = [buildATypeISO t1 t2 gs_predefs \\ t1 <- tvs1 & t2 <- tvs2] #! type_symb_ident = { - type_name = td_name, + type_ident = td_ident, type_index = { glob_module = module_index, glob_object = type_def_index }, type_arity = td_arity, type_prop = { @@ -2927,7 +2927,7 @@ where } #! gs = {gs & gs_heaps = gs_heaps, gs_modules = gs_modules} = (symbol_type, gs) - //---> ("isomap to/from type", td_name, symbol_type) + //---> ("isomap to/from type", td_ident, symbol_type) build_type_var name heaps #! (av, heaps) = buildAttrVar name heaps @@ -2938,7 +2938,7 @@ buildIsomapForTypeDef :: !DefinedSymbol !Int !Int !CheckedTypeDef !DefinedSymbol -> (!FunDef, !Index, !*GenericState) buildIsomapForTypeDef fun_def_sym group_index type_def_mod - type_def=:{td_name, td_index, td_arity, td_pos} + type_def=:{td_ident, td_index, td_arity, td_pos} from_fun to_fun gs=:{gs_main_dcl_module_n, gs_heaps, gs_predefs} #! arg_names = [ "iso" +++ toString n \\ n <- [1 .. td_arity]] @@ -2956,7 +2956,7 @@ buildIsomapType :: !Int !Int !*GenericState -> (!SymbolType, !*GenericState) buildIsomapType module_index type_def_index gs=:{gs_heaps, gs_modules, gs_predefs, gs_td_infos} - #! ({td_arity, td_name, td_pos}, gs_modules) = getTypeDef module_index type_def_index gs_modules + #! ({td_arity, td_ident, td_pos}, gs_modules) = getTypeDef module_index type_def_index gs_modules # ({tdi_kinds}, gs_td_infos) = gs_td_infos ! [module_index, type_def_index] # kind = case tdi_kinds of [] -> KindConst @@ -2980,8 +2980,8 @@ buildIsomapType module_index type_def_index , gt_arity = 2 } # dummy_generic_def = - { gen_name = td_name - , gen_member_name = td_name + { gen_ident = td_ident + , gen_member_ident = td_ident , gen_type = generic_type , gen_pos = td_pos , gen_kinds_ptr = nilPtr @@ -2994,7 +2994,7 @@ buildIsomapType module_index type_def_index // substitute generic variables with the type #! type_symb = { - type_name = td_name, + type_ident = td_ident, type_index = { glob_module = module_index, glob_object = type_def_index }, type_arity = td_arity, type_prop = { @@ -3027,7 +3027,7 @@ buildIsomapType module_index type_def_index #! gs_heaps = { gs_heaps & hp_type_heaps = hp_type_heaps } #! gs = {gs & gs_heaps = gs_heaps, gs_modules = gs_modules, gs_td_infos = gs_td_infos} = (symbol_type, gs) - //---> ("isomap to/from type", td_name, symbol_type) + //---> ("isomap to/from type", td_ident, symbol_type) where build_type_var1 name heaps #! (av, heaps) = buildAttrVar name heaps @@ -3037,12 +3037,12 @@ where buildIsomapForGeneric :: !DefinedSymbol !Int !GenericDef !*GenericState -> (!FunDef, !Index, !*GenericState) -buildIsomapForGeneric def_sym group_index {gen_type, gen_name, gen_pos} gs=:{gs_heaps,gs_main_dcl_module_n} +buildIsomapForGeneric def_sym group_index {gen_type, gen_ident, gen_pos} gs=:{gs_heaps,gs_main_dcl_module_n} #! arg_names = [ "iso" +++ toString n \\ n <- [1 .. gen_type.gt_arity]] #! (arg_vars, gs_heaps) = buildFreeVars arg_names gs_heaps #! curried_gt_type = curry_symbol_type gen_type.gt_type #! gs = {gs & gs_heaps = gs_heaps } - #! (body_expr, gs) = buildIsomapExpr curried_gt_type gen_type.gt_vars arg_vars gen_name gen_pos gs + #! (body_expr, gs) = buildIsomapExpr curried_gt_type gen_type.gt_vars arg_vars gen_ident gen_pos gs #! fun_def = makeFunction def_sym group_index arg_vars body_expr No [] gs_main_dcl_module_n gen_pos = (fun_def, def_sym.ds_index, gs) where @@ -3070,13 +3070,13 @@ where # (expr, gs_heaps) = buildIsomapIdApp gs_predefs gs_heaps = (expr, {gs & gs_heaps = gs_heaps}) - build_expr (TA {type_index, type_name} args) arg_type_vars arg_vars name pos gs + build_expr (TA {type_index, type_ident} args) arg_type_vars arg_vars name pos gs # (arg_exprs, gs) = build_exprs args arg_type_vars arg_vars name pos gs # {gs_heaps, gs_main_dcl_module_n, gs_gtd_infos} = gs # (gtd_info, gs_gtd_infos) = gs_gtd_infos ! [type_index.glob_module, type_index.glob_object] # gt = case gtd_info of (GTDI_Generic gt) -> gt - _ -> abort ("(generic.icl) type " +++ type_name.id_name +++ " does not have generic representation\n") + _ -> abort ("(generic.icl) type " +++ type_ident.id_name +++ " does not have generic representation\n") # (expr, gs_heaps) = buildFunApp gs_main_dcl_module_n gt.gtr_isomap arg_exprs gs_heaps = (expr, {gs & gs_heaps = gs_heaps, gs_gtd_infos = gs_gtd_infos}) @@ -3129,7 +3129,7 @@ buildInstance :: !DefinedSymbol !Int !ClassInstance !GenericDef !*GenericState buildInstance def_sym group_index instance_def=:{ins_type, ins_generic, ins_pos, ins_ident} - generic_def=:{gen_name, gen_type, gen_isomap} + generic_def=:{gen_ident, gen_type, gen_isomap} gs=:{gs_heaps,gs_main_dcl_module_n} #! original_arity = gen_type.gt_type.st_arity @@ -3145,7 +3145,7 @@ buildInstance #! gen_glob_def_sym = { glob_module = ins_generic.glob_module, glob_object = { - ds_ident = gen_name, + ds_ident = gen_ident, ds_index = ins_generic.glob_object, ds_arity = 0 } @@ -3204,7 +3204,7 @@ where build_instance_expr {at_type} cons_infos type_vars vars gen_sym gs = build_instance_expr1 at_type cons_infos type_vars vars gen_sym gs - build_instance_expr1 (TA {type_name, type_index, type_arity} type_args) cons_infos type_vars vars gen_sym gs + build_instance_expr1 (TA {type_ident, type_index, type_arity} type_args) cons_infos type_vars vars gen_sym gs # (arg_exprs, cons_infos, gs=:{gs_heaps}) = build_args type_args cons_infos gs with build_args [] cons_infos gs = ([], cons_infos, gs) @@ -3282,7 +3282,7 @@ where gs_modules, gs_error} - #! (generic_def=:{gen_name, gen_pos, gen_cons_ptr}, gs_modules) + #! (generic_def=:{gen_ident, gen_pos, gen_cons_ptr}, gs_modules) = getGenericDef glob_module glob_object.ds_index gs_modules #! (info, th_vars) = readPtr gen_cons_ptr th_vars #! gs_heaps = { gs_heaps & hp_type_heaps = {hp_type_heaps & th_vars = th_vars }} @@ -3293,7 +3293,7 @@ where TVI_ConsInstance fun_def_sym -> (fun_def_sym, gs_error) TVI_Empty - -> (EmptyDefinedSymbol, reportError gen_name gen_pos "no CONS instance provided" gs_error) + -> (EmptyDefinedSymbol, reportError gen_ident gen_pos "no CONS instance provided" gs_error) #! (app_expr, gs_heaps) = buildFunApp gs_main_dcl_module_n fun_def_sym [cons_info_expr:arg_exprs] gs_heaps = (app_expr, cons_infos, {gs & gs_heaps = gs_heaps, gs_modules = gs_modules, gs_error = gs_error}) @@ -3446,12 +3446,12 @@ buildAttrVar name heaps=:{hp_type_heaps=hp_type_heaps=:{th_attrs}} freshTypeVar :: !Ident !*TypeVarHeap -> (!TypeVar, !*TypeVarHeap) freshTypeVar name th_vars # (info_ptr, th_vars) = newPtr TVI_Empty th_vars - = ({tv_name = name, tv_info_ptr = info_ptr}, th_vars) + = ({tv_ident = name, tv_info_ptr = info_ptr}, th_vars) freshAttrVar :: !Ident !*AttrVarHeap -> (!AttributeVar, !*AttrVarHeap) freshAttrVar name th_attrs # (info_ptr, th_attrs) = newPtr AVI_Empty th_attrs - = ({av_name = name, av_info_ptr = info_ptr}, th_attrs) + = ({av_ident = name, av_info_ptr = info_ptr}, th_attrs) freshSymbolType :: String !SymbolType !*TypeHeaps -> (!SymbolType, !*TypeHeaps) freshSymbolType postfix st type_heaps @@ -3475,14 +3475,14 @@ freshSymbolType postfix st type_heaps = (new_st, type_heaps) where - subst_type_var postfix tv=:{tv_name={id_name}, tv_info_ptr} th_vars + subst_type_var postfix tv=:{tv_ident={id_name}, tv_info_ptr} th_vars # (tv, th_vars) = freshTypeVar {id_name=id_name+++postfix, id_info=nilPtr} th_vars = (tv, writePtr tv_info_ptr (TVI_Type (TV tv)) th_vars) subst_type_vars postfix tvs type_heaps=:{th_vars} # (tvs, th_vars) = mapSt (subst_type_var postfix) tvs th_vars = (tvs, {type_heaps & th_vars = th_vars}) - subst_attr_var postfix av=:{av_name={id_name}, av_info_ptr} th_attrs + subst_attr_var postfix av=:{av_ident={id_name}, av_info_ptr} th_attrs # (av, th_attrs) = freshAttrVar {id_name=id_name+++postfix, id_info=nilPtr} th_attrs = (av, writePtr av_info_ptr (AVI_Attr (TA_Var av)) th_attrs) subst_attr_vars postfix avs type_heaps=:{th_attrs} @@ -3567,9 +3567,9 @@ where = writePtr tv_info_ptr (TVI_Attribute ta) th_vars buildTypeApp :: !Index !CheckedTypeDef [AType] -> AType -buildTypeApp td_module {td_name, td_arity, td_index} args +buildTypeApp td_module {td_ident, td_arity, td_index} args # global_index = {glob_module = td_module, glob_object = td_index} - # type_symb = MakeTypeSymbIdent global_index td_name (length args) + # type_symb = MakeTypeSymbIdent global_index td_ident (length args) = makeAType (TA type_symb args) TA_Multi buildPredefTypeApp :: !Int [AType] !PredefinedSymbols -> !AType @@ -3604,7 +3604,7 @@ makeFunction {ds_index, ds_arity, ds_ident} group_index arg_vars body_expr opt_s | length arg_vars <> ds_arity = abort "length arg_vars <> ds_arity\n" = { - fun_symb = ds_ident, + fun_ident = ds_ident, fun_arity = ds_arity, fun_priority = NoPrio, fun_body = TransformedBody { @@ -3669,7 +3669,7 @@ where /* | fun_def.fun_index == index = fun_def - = abort ("conflicting fun_indexes of " +++ fun_def.fun_symb.id_name +++ + = abort ("conflicting fun_indexes of " +++ fun_def.fun_ident.id_name +++ toString fun_def.fun_index +++ " and " +++ toString index) */ @@ -3706,8 +3706,8 @@ where build_free_var :: !String !*Heaps -> (!FreeVar, !*Heaps) build_free_var name heaps=:{hp_var_heap} # (var_info_ptr, hp_var_heap) = newPtr VI_Empty hp_var_heap - # var_name = { id_name = name, id_info = nilPtr } - # free_var = { fv_def_level = NotALevel, fv_count = 0, fv_info_ptr = var_info_ptr, fv_name = var_name} + # var_ident = { id_name = name, id_info = nilPtr } + # free_var = { fv_def_level = NotALevel, fv_count = 0, fv_info_ptr = var_info_ptr, fv_ident = var_ident} = (free_var, {heaps & hp_var_heap = hp_var_heap}) //=================================== @@ -3749,7 +3749,7 @@ buildConsApp cons_mod {ds_ident, ds_index, ds_arity} arg_exprs heaps=:{hp_expres # cons_glob = {glob_module = cons_mod, glob_object = ds_index} # expr = App { app_symb = { - symb_name = ds_ident, + symb_ident = ds_ident, symb_kind = SK_Constructor cons_glob }, app_args = arg_exprs, @@ -3764,7 +3764,7 @@ buildFunApp fun_mod {ds_ident, ds_index, ds_arity} arg_exprs heaps=:{hp_expressi # fun_glob = {glob_module = fun_mod, glob_object = ds_index} # expr = App { app_symb = { - symb_name = ds_ident, + symb_ident = ds_ident, symb_kind = SK_Function fun_glob }, app_args = arg_exprs, @@ -3779,7 +3779,7 @@ buildGenericApp module_index {ds_ident, ds_index} kind arg_exprs heaps=:{hp_expr # glob_index = {glob_module = module_index, glob_object = ds_index} # expr = App { app_symb = { - symb_name = ds_ident, + symb_ident = ds_ident, symb_kind = SK_Generic glob_index kind }, app_args = arg_exprs, @@ -3847,7 +3847,7 @@ buildPredefConsApp predef_index args predefs heaps=:{hp_expression_heap} # pds_ident = predefined_idents.[predef_index] # global_index = {glob_module = pds_module, glob_object = pds_def} # symb_ident = { - symb_name = pds_ident, + symb_ident = pds_ident, symb_kind = SK_Constructor global_index } # (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty hp_expression_heap @@ -3869,7 +3869,7 @@ buildPredefFunApp predef_index args predefs heaps=:{hp_expression_heap} # pds_ident = predefined_idents.[predef_index] # global_index = {glob_module = pds_module, glob_object = pds_def} # symb_ident = { - symb_name = pds_ident, + symb_ident = pds_ident, symb_kind = SK_Function global_index } # (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty hp_expression_heap @@ -3902,9 +3902,9 @@ buildVarExpr :: !String !*Heaps -> (!Expression, !FreeVar, !*Heaps) buildVarExpr name heaps=:{hp_var_heap, hp_expression_heap} # (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty hp_expression_heap # (var_info_ptr, hp_var_heap) = newPtr VI_Empty hp_var_heap - # var_name = { id_name = name, id_info = nilPtr } - # fv = { fv_def_level = NotALevel, fv_count = 1, fv_info_ptr = var_info_ptr, fv_name = var_name} - # var = Var {var_name = var_name, var_expr_ptr = expr_info_ptr, var_info_ptr = var_info_ptr } + # var_ident = { id_name = name, id_info = nilPtr } + # fv = { fv_def_level = NotALevel, fv_count = 1, fv_info_ptr = var_info_ptr, fv_ident = var_ident} + # var = Var {var_ident = var_ident, var_expr_ptr = expr_info_ptr, var_info_ptr = var_info_ptr } # hp_var_heap = writePtr var_info_ptr (VI_Expression var) hp_var_heap # heaps = { heaps & hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap } = (var, fv, heaps) @@ -3919,16 +3919,16 @@ buildVarExprs [name:names] heaps buildFreeVar :: !String !*Heaps -> (!FreeVar, !*Heaps) buildFreeVar name heaps=:{hp_var_heap} # (var_info_ptr, hp_var_heap) = newPtr VI_Empty hp_var_heap - # var_name = { id_name = name, id_info = nilPtr } - # var = { fv_def_level = NotALevel, fv_count = 1, fv_info_ptr = var_info_ptr, fv_name = var_name} + # var_ident = { id_name = name, id_info = nilPtr } + # var = { fv_def_level = NotALevel, fv_count = 1, fv_info_ptr = var_info_ptr, fv_ident = var_ident} = (var, {heaps & hp_var_heap = hp_var_heap}) buildFreeVar0 :: !String !*Heaps -> (!FreeVar, !*Heaps) buildFreeVar0 name heaps=:{hp_var_heap} # (var_info_ptr, hp_var_heap) = newPtr VI_Empty hp_var_heap - # var_name = { id_name = name, id_info = nilPtr } - # var = { fv_def_level = NotALevel, fv_count = 0, fv_info_ptr = var_info_ptr, fv_name = var_name} + # var_ident = { id_name = name, id_info = nilPtr } + # var = { fv_def_level = NotALevel, fv_count = 0, fv_info_ptr = var_info_ptr, fv_ident = var_ident} = (var, {heaps & hp_var_heap = hp_var_heap}) @@ -3938,9 +3938,9 @@ buildFreeVars names heaps = mapSt buildFreeVar names heaps // create expression from a variable buildBoundVarExpr :: !FreeVar !*Heaps -> (!Expression, !FreeVar, !*Heaps) -buildBoundVarExpr free_var=:{fv_info_ptr, fv_name, fv_count} heaps=:{hp_expression_heap, hp_var_heap} +buildBoundVarExpr free_var=:{fv_info_ptr, fv_ident, fv_count} heaps=:{hp_expression_heap, hp_var_heap} # (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty hp_expression_heap - # expr = Var {var_name = fv_name, var_expr_ptr = expr_info_ptr, var_info_ptr = fv_info_ptr } + # expr = Var {var_ident = fv_ident, var_expr_ptr = expr_info_ptr, var_info_ptr = fv_info_ptr } # hp_var_heap = writePtr fv_info_ptr (VI_Expression expr) hp_var_heap # heaps = { heaps & hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap } = (expr, {free_var & fv_count = fv_count + 1}, heaps) @@ -4082,7 +4082,7 @@ mapExprSt f expr st = f expr st copyFunDef :: !FunDef !Index !Index !*Heaps -> (!FunDef, !*Heaps) -copyFunDef fun_def=:{fun_symb,fun_arity,fun_body,fun_info} fun_index group_index gs_heaps +copyFunDef fun_def=:{fun_ident,fun_arity,fun_body,fun_info} fun_index group_index gs_heaps # (TransformedBody {tb_args, tb_rhs}) = fun_body # (fresh_arg_vars, gs_heaps) = copy_vars tb_args gs_heaps @@ -4096,7 +4096,7 @@ copyFunDef fun_def=:{fun_symb,fun_arity,fun_body,fun_info} fun_index group_index # fun_def = { fun_def // & fun_index = fun_index - //, fun_symb = makeIdent "zzzzzzzzzzzz" + //, fun_ident = makeIdent "zzzzzzzzzzzz" & fun_body = TransformedBody { tb_args = fresh_arg_vars, tb_rhs = copied_rhs } , fun_info = { fun_info @@ -4108,7 +4108,7 @@ copyFunDef fun_def=:{fun_symb,fun_arity,fun_body,fun_info} fun_index group_index where copy_vars vars heaps # (fresh_vars, heaps) = copyVars vars heaps - # infos = [VI_Variable fv_name fv_info_ptr\\ {fv_name,fv_info_ptr} <- fresh_vars] + # infos = [VI_Variable fv_ident fv_info_ptr\\ {fv_ident,fv_info_ptr} <- fresh_vars] # heaps = setVarInfos vars infos heaps = (fresh_vars, heaps) diff --git a/frontend/generics1.icl b/frontend/generics1.icl index 79c5b70..ef5e590 100644 --- a/frontend/generics1.icl +++ b/frontend/generics1.icl @@ -176,9 +176,9 @@ where dump_funs n funs | n == size funs = funs - #! ({fun_symb, fun_type, fun_body}, funs) = funs ! [n] + #! ({fun_ident, fun_type, fun_body}, funs) = funs ! [n] #! funs = funs - //---> ("icl function ", fun_symb, n, fun_type, fun_body) + //---> ("icl function ", fun_ident, n, fun_type, fun_body) = dump_funs (inc n) funs dump_dcl_modules n dcl_modules | n == size dcl_modules @@ -189,9 +189,9 @@ where dump_dcl_funs n dcl_funs dcl_modules | n == size dcl_funs = dcl_modules - # {ft_symb, ft_type} = dcl_funs.[n] + # {ft_ident, ft_type} = dcl_funs.[n] = dump_dcl_funs (inc n) dcl_funs dcl_modules - //---> ("dcl function", ft_symb, n, ft_type) + //---> ("dcl function", ft_ident, n, ft_type) //**************************************************************************************** @@ -228,7 +228,7 @@ where #! modules = {modules & [n].com_generic_defs = com_generic_defs} = clear_module (inc n) modules heaps - clear_generic_def _ generic_def=:{gen_name,gen_info_ptr} heaps=:{hp_generic_heap} + clear_generic_def _ generic_def=:{gen_ident,gen_info_ptr} heaps=:{hp_generic_heap} #! (gen_info, hp_generic_heap) = readPtr gen_info_ptr hp_generic_heap #! gen_info = { gen_info @@ -264,8 +264,8 @@ buildGenericRepresentations gs=:{gs_main_module, gs_modules, gs_funs, gs_groups} where on_gencase index - case_def=:{gc_type_cons=TypeConsSymb {type_index={glob_module,glob_object}, type_name}, - gc_name, gc_body=GCB_FunIndex fun_index, gc_pos} + case_def=:{gc_type_cons=TypeConsSymb {type_index={glob_module,glob_object}, type_ident}, + gc_ident, gc_body=GCB_FunIndex fun_index, gc_pos} (funs_and_groups, gs=:{gs_modules, gs_td_infos, gs_funs}) #! (type_def, gs_modules) = gs_modules![glob_module].com_type_defs.[glob_object] #! (td_info, gs_td_infos) = gs_td_infos![glob_module, glob_object] @@ -283,16 +283,16 @@ where -> case type_def.td_rhs of SynType _ - # gs_error = reportError gc_name gc_pos ("cannot derive a generic instance for a synonym type " +++ type_def.td_name.id_name) gs.gs_error + # gs_error = reportError gc_ident gc_pos ("cannot derive a generic instance for a synonym type " +++ type_def.td_ident.id_name) gs.gs_error -> (funs_and_groups, {gs & gs_error = gs_error}) AbstractType _ - # gs_error = reportError gc_name gc_pos ("cannot derive a generic instance for an abstract type " +++ type_def.td_name.id_name) gs.gs_error + # gs_error = reportError gc_ident gc_pos ("cannot derive a generic instance for an abstract type " +++ type_def.td_ident.id_name) gs.gs_error -> (funs_and_groups, {gs & gs_error = gs_error}) _ -> case td_info.tdi_gen_rep of Yes _ -> (funs_and_groups, gs) - //---> ("generic representation is already built", type_name) + //---> ("generic representation is already built", type_ident) No #! (gen_type_rep, funs_and_groups, gs) = buildGenericTypeRep type_def_gi funs_and_groups gs @@ -302,7 +302,7 @@ where #! gs_td_infos = {gs_td_infos & [glob_module, glob_object] = td_info} # gs = {gs & gs_td_infos = gs_td_infos } -> (funs_and_groups, gs) - //---> ("build generic representation", type_name) + //---> ("build generic representation", type_ident) on_gencase _ _ st = st @@ -357,7 +357,7 @@ buildGenericTypeRep type_index funs_and_groups , gs_exprh = hp_expression_heap } = ({gtr_type=atype,gtr_iso=iso_fun_ds}, funs_and_groups, gs) - //---> ("buildGenericTypeRep", type_def.td_name, atype) + //---> ("buildGenericTypeRep", type_def.td_ident, atype) //======================================================================================== // the structure type @@ -417,25 +417,25 @@ buildStructType :: , (!*Modules, !*TypeDefInfos, !*Heaps, !*ErrorAdmin) ) buildStructType {gi_module,gi_index} cons_infos predefs (modules, td_infos, heaps, error) - # (type_def=:{td_name}, modules) = modules![gi_module].com_type_defs.[gi_index] + # (type_def=:{td_ident}, modules) = modules![gi_module].com_type_defs.[gi_index] //# (common_defs, modules) = modules ! [gi_module] = build_type type_def cons_infos (modules, td_infos, heaps, error) - //---> ("buildStructureType", td_name, atype) + //---> ("buildStructureType", td_ident, atype) where - build_type {td_rhs=AlgType alts, td_name, td_pos} cons_infos st - # (cons_args, st) = zipWithSt (build_alt td_name td_pos) alts cons_infos st + build_type {td_rhs=AlgType alts, td_ident, td_pos} cons_infos st + # (cons_args, st) = zipWithSt (build_alt td_ident td_pos) alts cons_infos st = (build_sum_type cons_args, st) /* - build_type {td_rhs=RecordType {rt_constructor}, td_name, td_pos} [cdi] st - = build_alt td_name td_pos rt_constructor cdi st + build_type {td_rhs=RecordType {rt_constructor}, td_ident, td_pos} [cdi] st + = build_alt td_ident td_pos rt_constructor cdi st */ build_type - {td_rhs=RecordType {rt_constructor}, td_name, td_pos} + {td_rhs=RecordType {rt_constructor}, td_ident, td_pos} [{ci_cons_info, ci_field_infos}] (modules, td_infos, heaps, error) # ({cons_type={st_args}}, modules) = modules![gi_module].com_cons_defs.[rt_constructor.ds_index] - # (args, st) = mapSt (convertATypeToGenTypeStruct td_name td_pos predefs) st_args (modules, td_infos, heaps, error) + # (args, st) = mapSt (convertATypeToGenTypeStruct td_ident td_pos predefs) st_args (modules, td_infos, heaps, error) # args = SwitchGenericInfo [GTSField fi arg \\ arg <- args & fi <- ci_field_infos] args @@ -444,19 +444,19 @@ where = (type, st) /* - build_type {td_rhs=SynType type,td_name, td_pos} cons_infos common_defs st - = convertATypeToGenTypeStruct td_name td_pos type st + build_type {td_rhs=SynType type,td_ident, td_pos} cons_infos common_defs st + = convertATypeToGenTypeStruct td_ident td_pos type st */ - build_type {td_rhs=SynType type,td_name, td_pos} cons_infos (modules, td_infos, heaps, error) - # error = reportError td_name td_pos "cannot build a generic representation of a synonym type" error + build_type {td_rhs=SynType type,td_ident, td_pos} cons_infos (modules, td_infos, heaps, error) + # error = reportError td_ident td_pos "cannot build a generic representation of a synonym type" error = (GTSE, (modules, td_infos, heaps, error)) - build_type td=:{td_rhs=(AbstractType _),td_name, td_arity, td_args, td_pos} cdis (modules, td_infos, heaps, error) - # error = reportError td_name td_pos "cannot build a generic representation of an abstract type" error + build_type td=:{td_rhs=(AbstractType _),td_ident, td_arity, td_args, td_pos} cdis (modules, td_infos, heaps, error) + # error = reportError td_ident td_pos "cannot build a generic representation of an abstract type" error = (GTSE, (modules, td_infos, heaps, error)) - build_alt td_name td_pos cons_def_sym=:{ds_index} {ci_cons_info} (modules, td_infos, heaps, error) + build_alt td_ident td_pos cons_def_sym=:{ds_index} {ci_cons_info} (modules, td_infos, heaps, error) # ({cons_type={st_args}}, modules) = modules![gi_module].com_cons_defs.[ds_index] - # (args, st) = mapSt (convertATypeToGenTypeStruct td_name td_pos predefs) st_args (modules, td_infos, heaps, error) + # (args, st) = mapSt (convertATypeToGenTypeStruct td_ident td_pos predefs) st_args (modules, td_infos, heaps, error) # prod_type = build_prod_type args # type = SwitchGenericInfo (GTSCons ci_cons_info prod_type) prod_type = (type, st) @@ -533,12 +533,12 @@ buildTypeDefInfo td_module td=:{td_rhs = AlgType alts} main_module_index predefs buildTypeDefInfo td_module td=:{td_rhs=RecordType {rt_constructor, rt_fields}} main_module_index predefs funs_and_groups modules heaps error = buildTypeDefInfo2 td_module td [rt_constructor] [x\\x<-:rt_fields] main_module_index predefs funs_and_groups modules heaps error -buildTypeDefInfo td_module td=:{td_rhs = SynType type, td_name, td_pos} main_module_index predefs funs_and_groups modules heaps error - # error = reportError td_name td_pos "cannot build constructor uinformation for a synonym type" error +buildTypeDefInfo td_module td=:{td_rhs = SynType type, td_ident, td_pos} main_module_index predefs funs_and_groups modules heaps error + # error = reportError td_ident td_pos "cannot build constructor uinformation for a synonym type" error = buildTypeDefInfo2 td_module td [] [] main_module_index predefs funs_and_groups modules heaps error -buildTypeDefInfo td_module td=:{td_rhs = AbstractType _, td_name, td_pos} main_module_index predefs funs_and_groups modules heaps error - # error = reportError td_name td_pos "cannot build constructor uinformation for an abstract type" error +buildTypeDefInfo td_module td=:{td_rhs = AbstractType _, td_ident, td_pos} main_module_index predefs funs_and_groups modules heaps error + # error = reportError td_ident td_pos "cannot build constructor uinformation for an abstract type" error = buildTypeDefInfo2 td_module td [] [] main_module_index predefs funs_and_groups modules heaps error buildTypeDefInfo2 td_module td alts fields main_module_index predefs funs_and_groups modules heaps error @@ -549,7 +549,7 @@ where dummy_ds = {ds_index = -1, ds_arity = 0, ds_ident = makeIdent "<dummy_generic_info>"} dummy = (dummy_ds, repeatn (length alts) dummy_ds) -buildTypeDefInfo1 td_module {td_name, td_pos, td_arity} alts fields main_module_index predefs (fun_index, group_index, funs, groups) modules heaps error +buildTypeDefInfo1 td_module {td_ident, td_pos, td_arity} alts fields main_module_index predefs (fun_index, group_index, funs, groups) modules heaps error # num_conses = length alts # num_fields = length fields @@ -565,11 +565,11 @@ buildTypeDefInfo1 td_module {td_name, td_pos, td_arity} alts fields main_module_ # group = {group_members = [fun_index .. new_fun_index - 1]} # new_groups = [group:groups] - # type_def_dsc_ds = {ds_arity=0, ds_ident=makeIdent("tdi_"+++td_name.id_name), ds_index=type_def_dsc_index} + # type_def_dsc_ds = {ds_arity=0, ds_ident=makeIdent("tdi_"+++td_ident.id_name), ds_index=type_def_dsc_index} # cons_dsc_dss = [ {ds_arity=0, ds_ident=makeIdent("cdi_"+++ds_ident.id_name), ds_index=i} \\ {ds_ident} <- alts & i <- cons_dsc_indexes] - # field_dsc_dss = [ {ds_arity=0, ds_ident=makeIdent("fdi_"+++fs_name.id_name), ds_index=i} \\ - {fs_name} <- fields & i <- field_dsc_indexes] + # field_dsc_dss = [ {ds_arity=0, ds_ident=makeIdent("fdi_"+++fs_ident.id_name), ds_index=i} \\ + {fs_ident} <- fields & i <- field_dsc_indexes] # (type_def_dsc_fun, heaps) = build_type_def_dsc group_index cons_dsc_dss type_def_dsc_ds heaps @@ -597,7 +597,7 @@ buildTypeDefInfo1 td_module {td_name, td_pos, td_arity} alts fields main_module_ where build_type_def_dsc group_index cons_info_dss {ds_index, ds_ident} heaps - # td_name_expr = makeStringExpr td_name.id_name + # td_name_expr = makeStringExpr td_ident.id_name # td_arity_expr = makeIntExpr td_arity # num_conses_expr = makeIntExpr (length alts) # (cons_info_exprs, heaps) = mapSt (\x st->buildFunApp main_module_index x [] st) cons_info_dss heaps @@ -615,9 +615,9 @@ where = (fun, heaps) build_cons_dsc group_index type_def_info_ds field_dsc_dss cons_info_ds cons_ds (modules, heaps) - # ({cons_symb, cons_type, cons_priority,cons_index}, modules) + # ({cons_ident, cons_type, cons_priority,cons_index}, modules) = modules! [td_module].com_cons_defs.[cons_ds.ds_index] - # name_expr = makeStringExpr cons_symb.id_name + # name_expr = makeStringExpr cons_ident.id_name # arity_expr = makeIntExpr cons_type.st_arity # (prio_expr, heaps) = make_prio_expr cons_priority heaps # (type_def_expr, heaps) = buildFunApp main_module_index type_def_info_ds [] heaps @@ -669,11 +669,11 @@ where make_expr :: !Type !*Heaps -> (!Expression, !*Heaps) make_expr (TA type_symb arg_types) heaps # (arg_exprs, heaps) = mapSt make_expr1 arg_types heaps - # (type_cons, heaps) = make_type_cons type_symb.type_name.id_name heaps + # (type_cons, heaps) = make_type_cons type_symb.type_ident.id_name heaps = make_apps type_cons arg_exprs heaps make_expr (TAS type_symb arg_types _) heaps # (arg_exprs, heaps) = mapSt make_expr1 arg_types heaps - # (type_cons, heaps) = make_type_cons type_symb.type_name.id_name heaps + # (type_cons, heaps) = make_type_cons type_symb.type_ident.id_name heaps = make_apps type_cons arg_exprs heaps make_expr (x --> y) heaps # (x, heaps) = make_expr1 x heaps @@ -685,18 +685,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_name} :@: arg_types) heaps + make_expr (CV {tv_ident} :@: arg_types) heaps # (arg_exprs, heaps) = mapSt make_expr1 arg_types heaps - # (tv_expr, heaps) = make_type_var tv_name.id_name heaps + # (tv_expr, heaps) = make_type_var tv_ident.id_name heaps = make_apps tv_expr arg_exprs heaps make_expr (TB bt) heaps = make_type_cons (toString bt) heaps - make_expr (TV {tv_name}) heaps - = make_type_var tv_name.id_name heaps - make_expr (GTV {tv_name}) heaps - = make_type_var tv_name.id_name heaps - make_expr (TQV {tv_name}) heaps - = make_type_var tv_name.id_name 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 TE heaps = make_type_cons "<error>" heaps make_expr _ heaps @@ -717,8 +717,8 @@ where 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_name, fs_index} (modules, heaps) - # name_expr = makeStringExpr fs_name.id_name + build_field_dsc group_index cons_dsc_ds field_dsc_ds {fs_ident, fs_index} (modules, heaps) + # name_expr = makeStringExpr fs_ident.id_name # index_expr = makeIntExpr fs_index # (cons_expr, heaps) = buildFunApp main_module_index cons_dsc_ds [] heaps # (body_expr, heaps) @@ -773,7 +773,7 @@ buildConversionIso :: , !*ErrorAdmin ) buildConversionIso - type_def=:{td_name, td_pos} + type_def=:{td_ident, td_pos} from_fun to_fun main_dcl_module_n @@ -785,10 +785,10 @@ buildConversionIso #! (to_expr, heaps) = buildFunApp main_dcl_module_n to_fun [] heaps #! (iso_expr, heaps) = build_iso to_expr from_expr heaps - #! ident = makeIdent ("iso" +++ td_name.id_name) + #! ident = makeIdent ("iso" +++ td_ident.id_name) #! (def_sym, funs_and_groups) = buildFunAndGroup ident [] iso_expr No main_dcl_module_n td_pos funs_and_groups = (def_sym, funs_and_groups, heaps, error) - //---> ("buildConversionIso", td_name, let (_,_,fs,_) = funs_and_groups in hd fs) + //---> ("buildConversionIso", td_ident, let (_,_,fs,_) = funs_and_groups in hd fs) where build_iso to_expr from_expr heaps = buildPredefConsApp PD_ConsBimap [to_expr, from_expr] predefs heaps @@ -809,7 +809,7 @@ buildConversionTo :: ) buildConversionTo type_def_mod - type_def=:{td_rhs, td_name, td_index, td_pos} + type_def=:{td_rhs, td_ident, td_index, td_pos} main_module_index predefs funs_and_groups @@ -818,16 +818,16 @@ buildConversionTo # (arg_expr, arg_var, heaps) = buildVarExpr "x" heaps # (body_expr, heaps, error) = build_expr_for_type_rhs type_def_mod td_index td_rhs arg_expr heaps error - # fun_name = makeIdent ("fromGenericTo" +++ td_name.id_name) + # fun_name = makeIdent ("fromGenericTo" +++ td_ident.id_name) | not error.ea_ok # (def_sym, funs_and_groups) = (buildFunAndGroup fun_name [] EE No main_module_index td_pos funs_and_groups) = (def_sym, funs_and_groups, heaps, error) - //---> ("buildConversionTo failed", td_name) + //---> ("buildConversionTo failed", td_ident) # (def_sym, funs_and_groups) = (buildFunAndGroup fun_name [arg_var] body_expr No main_module_index td_pos funs_and_groups) = (def_sym, funs_and_groups, heaps, error) - //---> ("buildConversionTo", td_name, let (_,_,fs,_) = funs_and_groups in hd fs) + //---> ("buildConversionTo", td_ident, let (_,_,fs,_) = funs_and_groups in hd fs) where // build conversion for type rhs build_expr_for_type_rhs :: @@ -846,10 +846,10 @@ where build_expr_for_type_rhs type_def_mod type_def_index (RecordType {rt_constructor}) arg_expr heaps error = build_expr_for_conses True type_def_mod type_def_index [rt_constructor] arg_expr heaps error build_expr_for_type_rhs type_def_mod type_def_index (AbstractType _) arg_expr heaps error - #! error = checkErrorWithIdentPos (newPosition td_name td_pos) "cannot build isomorphisms for an abstract type" error + #! error = checkErrorWithIdentPos (newPosition td_ident td_pos) "cannot build isomorphisms for an abstract type" error = (EE, heaps, error) build_expr_for_type_rhs type_def_mod type_def_index (SynType _) arg_expr heaps error - #! error = checkErrorWithIdentPos (newPosition td_name td_pos) "cannot build isomorphisms for a synonym type" error + #! error = checkErrorWithIdentPos (newPosition td_ident td_pos) "cannot build isomorphisms for a synonym type" error = (EE, heaps, error) // build conversion for constructors of a type def @@ -941,7 +941,7 @@ buildConversionFrom :: ) buildConversionFrom type_def_mod - type_def=:{td_rhs, td_name, td_index, td_pos} + type_def=:{td_rhs, td_ident, td_index, td_pos} main_module_index predefs funs_and_groups @@ -949,16 +949,16 @@ buildConversionFrom error # (body_expr, arg_var, heaps, error) = build_expr_for_type_rhs type_def_mod td_rhs heaps error - # fun_name = makeIdent ("toGenericFrom" +++ td_name.id_name) + # fun_name = makeIdent ("toGenericFrom" +++ td_ident.id_name) | not error.ea_ok # (def_sym, funs_and_groups) = (buildFunAndGroup fun_name [] EE No main_module_index td_pos funs_and_groups) = (def_sym, funs_and_groups, heaps, error) - //---> ("buildConversionFrom failed", td_name) + //---> ("buildConversionFrom failed", td_ident) # (def_sym, funs_and_groups) = (buildFunAndGroup fun_name [arg_var] body_expr No main_module_index td_pos funs_and_groups) = (def_sym, funs_and_groups, heaps, error) - //---> ("buildConversionFrom", td_name, let (_,_,fs,_) = funs_and_groups in hd fs) + //---> ("buildConversionFrom", td_ident, let (_,_,fs,_) = funs_and_groups in hd fs) where // build expression for type def rhs build_expr_for_type_rhs :: @@ -976,12 +976,12 @@ where build_expr_for_type_rhs type_def_mod (RecordType {rt_constructor}) heaps error = build_sum True type_def_mod [rt_constructor] heaps error build_expr_for_type_rhs type_def_mod (AbstractType _) heaps error - #! error = reportError td_name td_pos "cannot build isomorphisms for an abstract type" error - # dummy_fv = {fv_def_level=(-1), fv_count=0, fv_name=makeIdent "dummy", fv_info_ptr=nilPtr} + #! error = reportError td_ident td_pos "cannot build isomorphisms for an abstract type" error + # dummy_fv = {fv_def_level=(-1), fv_count=0, fv_ident=makeIdent "dummy", fv_info_ptr=nilPtr} = (EE, dummy_fv, heaps, error) build_expr_for_type_rhs type_def_mod (SynType _) heaps error - #! error = reportError td_name td_pos "cannot build isomorphisms for a synonym type" error - # dummy_fv = {fv_def_level=(-1), fv_count=0, fv_name=makeIdent "dummy", fv_info_ptr=nilPtr} + #! error = reportError td_ident td_pos "cannot build isomorphisms for a synonym type" error + # dummy_fv = {fv_def_level=(-1), fv_count=0, fv_ident=makeIdent "dummy", fv_info_ptr=nilPtr} = (EE, dummy_fv, heaps, error) // build expression for sums @@ -1168,7 +1168,7 @@ where ) on_gencase module_index index - gencase=:{gc_name,gc_generic, gc_type_cons} + gencase=:{gc_ident,gc_generic, gc_type_cons} st gs=:{gs_modules, gs_td_infos} @@ -1242,7 +1242,7 @@ where = (KindConst, td_infos) get_kind_of_type_cons TypeConsArrow td_infos = (KindArrow [KindConst,KindConst], td_infos) - get_kind_of_type_cons (TypeConsSymb {type_name, type_index}) td_infos + get_kind_of_type_cons (TypeConsSymb {type_ident, type_index}) td_infos #! ({tdi_kinds}, td_infos) = td_infos ! [type_index.glob_module,type_index.glob_object] = (if (isEmpty tdi_kinds) KindConst (KindArrow tdi_kinds), td_infos) get_kind_of_type_cons (TypeConsVar tv) td_infos @@ -1297,12 +1297,12 @@ where // - context restrictions on generic variables are not allowed buildMemberType :: !GenericDef !TypeKind !TypeVar !*GenericState -> ( !SymbolType, !*GenericState) -buildMemberType gen_def=:{gen_name,gen_pos,gen_type,gen_vars} kind class_var gs=:{gs_predefs} +buildMemberType gen_def=:{gen_ident,gen_pos,gen_type,gen_vars} kind class_var gs=:{gs_predefs} #! (gen_type, gs) = add_bimap_contexts gen_def gs #! th = {th_vars = gs.gs_tvarh, th_attrs = gs.gs_avarh} #! (kind_indexed_st, gatvs, th, gs_error) - = buildKindIndexedType gen_type gen_vars kind gen_name gen_pos th gs.gs_error + = buildKindIndexedType gen_type gen_vars kind gen_ident gen_pos th gs.gs_error #! (member_st, th, gs_error) = replace_generic_vars_with_class_var kind_indexed_st gatvs kind th gs_error @@ -1315,7 +1315,7 @@ buildMemberType gen_def=:{gen_name,gen_pos,gen_type,gen_vars} kind class_var gs= # {th_vars, th_attrs} = th #! gs = {gs & gs_avarh = th_attrs, gs_tvarh = th_vars, gs_error = gs_error } = (member_st, gs) - //---> ("buildMemberType returns", gen_name, kind, member_st) + //---> ("buildMemberType returns", gen_ident, kind, member_st) where add_bimap_contexts {gen_type=gen_type=:{st_vars, st_context}, gen_vars, gen_info_ptr} @@ -1395,18 +1395,18 @@ where buildClassAndMember module_index class_index member_index kind - gen_def=:{gen_name, gen_pos} + gen_def=:{gen_ident, gen_pos} gs=:{gs_tvarh} # (class_var, gs_tvarh) = freshTypeVar (makeIdent "class_var") gs_tvarh #! (member_def, gs) = build_class_member class_var {gs & gs_tvarh = gs_tvarh} #! class_def = build_class class_var member_def = (class_def, member_def, gs) - //---> ("buildClassAndMember", gen_def.gen_name, kind) + //---> ("buildClassAndMember", gen_def.gen_ident, kind) where - class_ident = genericIdentToClassIdent gen_def.gen_name kind - member_ident = genericIdentToMemberIdent gen_def.gen_name kind + class_ident = genericIdentToClassIdent gen_def.gen_ident kind + member_ident = genericIdentToMemberIdent gen_def.gen_ident kind class_ds = {ds_index = class_index, ds_ident = class_ident, ds_arity = 1} build_class_member class_var gs=:{gs_varh} @@ -1422,7 +1422,7 @@ where = buildMemberType gen_def kind class_var gs #! member_type = { member_type & st_context = [type_context : member_type.st_context] } #! member_def = { - me_symb = member_ident, + me_ident = member_ident, me_class = {glob_module = module_index, glob_object = class_index}, me_offset = 0, me_type = member_type, @@ -1445,7 +1445,7 @@ where , ds_index = NoIndex/*index in the type def table, filled in later*/ } #! class_def = { - class_name = class_ident, + class_ident = class_ident, class_arity = 1, class_args = [class_var], class_context = [], @@ -1581,14 +1581,14 @@ where , !*ErrorAdmin ) ) - convert_gencase module_index gc_index gencase=:{gc_name, gc_type} st + convert_gencase module_index gc_index gencase=:{gc_ident, gc_type} st #! st = build_main_instance module_index gc_index gencase st #! st = build_shorthand_instances module_index gc_index gencase st = st - //---> ("convert gencase", gc_name, gc_type) + //---> ("convert gencase", gc_ident, gc_type) build_main_instance module_index gc_index - gencase=:{gc_name, gc_kind, gc_generic, gc_pos, gc_type, gc_type_cons, gc_body = GCB_FunIndex fun_index} + gencase=:{gc_ident, gc_kind, gc_generic, gc_pos, gc_type, gc_type_cons, gc_body = GCB_FunIndex fun_index} (dcl_functions, modules, (fun_info, ins_info, fun_defs, td_infos, heaps, error)) #! ({gen_classes}, modules, heaps) = get_generic_info gc_generic modules heaps @@ -1630,7 +1630,7 @@ where = st build_shorthand_instances module_index gc_index - gencase=:{gc_kind=KindArrow kinds, gc_type, gc_generic, gc_name, gc_pos} + gencase=:{gc_kind=KindArrow kinds, gc_type, gc_generic, gc_ident, gc_pos} st = foldSt build_shorthand_instance [1 .. length kinds] st where @@ -1682,7 +1682,7 @@ where } = (ins_type, {heaps & hp_type_heaps = {th & th_vars = th_vars}, hp_var_heap = hp_var_heap}) - //---> ("instance type for shorthand instance", gc_name, gc_type, ins_type) + //---> ("instance type for shorthand instance", gc_ident, gc_type, ins_type) where fill_type_args (TA type_symb_ident=:{type_arity} type_args) new_type_args #! type_arity = type_arity + length new_type_args @@ -1703,7 +1703,7 @@ where { tc_class = TCClass { glob_module=gci_module // the same as icl module , glob_object = - { ds_ident = genericIdentToClassIdent gc_name gci_kind + { ds_ident = genericIdentToClassIdent gc_ident gci_kind , ds_index = gci_class , ds_arity = 1 } @@ -1713,15 +1713,15 @@ where } = (type_context, hp_var_heap) - build_shorthand_instance_member module_index this_kind gencase=:{gc_generic, gc_name, gc_kind, gc_pos} st class_infos fun_info heaps + build_shorthand_instance_member module_index this_kind gencase=:{gc_generic, gc_ident, gc_kind, gc_pos} st class_infos fun_info heaps #! arg_var_names = ["x" +++ toString i \\ i <- [1..st.st_arity-SwitchGenericInfo 1 0]] #! (arg_var_exprs, arg_vars, heaps) = buildVarExprs arg_var_names heaps #! (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty heaps.hp_expression_heap #! heaps = {heaps & hp_expression_heap = hp_expression_heap} - #! fun_name = genericIdentToMemberIdent gc_name this_kind + #! fun_name = genericIdentToMemberIdent gc_ident this_kind - # (gen_exprs, heaps) = mapSt (build_generic_app gc_generic gc_name) class_infos heaps + # (gen_exprs, heaps) = mapSt (build_generic_app gc_generic gc_ident) class_infos heaps #! arg_exprs = gen_exprs ++ arg_var_exprs @@ -1731,7 +1731,7 @@ where # (body_expr, heaps) = buildGenericApp gc_generic.gi_module gc_generic.gi_index - gc_name gc_kind arg_exprs heaps + gc_ident gc_kind arg_exprs heaps #! (st, heaps) = fresh_symbol_type st heaps @@ -1741,21 +1741,21 @@ where = (fun_ds, fun_info, heaps) //---> ("shorthand instance body", body_expr) where - build_generic_app {gi_module, gi_index} gc_name {gci_kind} heaps + build_generic_app {gi_module, gi_index} gc_ident {gci_kind} heaps # (generic_info_expr, heaps) = build_generic_info_expr heaps - = buildGenericApp gi_module gi_index gc_name gci_kind (SwitchGenericInfo [generic_info_expr] []) heaps + = buildGenericApp gi_module gi_index gc_ident gci_kind (SwitchGenericInfo [generic_info_expr] []) heaps build_generic_info_expr heaps = buildPredefConsApp PD_NoGenericInfo [] gs_predefs heaps build_class_instance this_kind class_index gencase member_fun_ds ins_type (ins_index, instances) - # {gc_pos, gc_name, gc_kind} = gencase + # {gc_pos, gc_ident, gc_kind} = gencase - #! class_name = genericIdentToClassIdent gc_name this_kind - #! class_ds = {ds_index = class_index, ds_arity=1, ds_ident=class_name} + #! class_ident = genericIdentToClassIdent gc_ident this_kind + #! class_ds = {ds_index = class_index, ds_arity=1, ds_ident=class_ident} #! ins = { ins_class = {glob_module=gs_main_module, glob_object=class_ds} - , ins_ident = class_name + , ins_ident = class_ident , ins_type = ins_type , ins_members = {member_fun_ds} , ins_specials = SP_None @@ -1790,18 +1790,18 @@ where update_dcl_function :: !Index !GenericCaseDef !SymbolType !*{#FunType} !*Heaps -> (!*{#FunType}, !*Heaps) - update_dcl_function fun_index {gc_name, gc_type_cons} symbol_type dcl_functions heaps + update_dcl_function fun_index {gc_ident, gc_type_cons} symbol_type dcl_functions heaps | fun_index < size dcl_functions #! (symbol_type, heaps) = fresh_symbol_type symbol_type heaps #! (fun, dcl_functions) = dcl_functions ! [fun_index] #! fun = { fun - & ft_symb = genericIdentToFunIdent gc_name gc_type_cons + & ft_ident = genericIdentToFunIdent gc_ident gc_type_cons , ft_type = symbol_type } #! dcl_functions = { dcl_functions & [fun_index] = fun} = (dcl_functions, heaps) - //---> ("update dcl function", fun.ft_symb, fun_index, symbol_type) + //---> ("update dcl function", fun.ft_ident, fun_index, symbol_type) = (dcl_functions, heaps) //---> ("update dcl function: not in the dcl module", fun_index) @@ -1817,24 +1817,24 @@ where !Index !GenericCaseDef !SymbolType !Index ![Group] !*{#FunDef} !*TypeDefInfos !*{#CommonDefs} !*Heaps !*ErrorAdmin -> (!Index, ![Group], !*{#FunDef}, !*TypeDefInfos, !*{#CommonDefs}, !*Heaps, !*ErrorAdmin) - update_icl_function fun_index gencase=:{gc_name, gc_type_cons, gc_pos} st group_index groups fun_defs td_infos modules heaps error + update_icl_function fun_index gencase=:{gc_ident, gc_type_cons, gc_pos} st group_index groups fun_defs td_infos modules heaps error #! (st, heaps) = fresh_symbol_type st heaps #! (fun=:{fun_body, fun_arity}, fun_defs) = fun_defs ! [fun_index] - #! fun_ident = genericIdentToFunIdent gc_name gc_type_cons + #! fun_ident = genericIdentToFunIdent gc_ident gc_type_cons = case fun_body of TransformedBody tb // user defined case | fun_arity <> st.st_arity - # error = reportError gc_name gc_pos + # error = reportError gc_ident gc_pos ("incorrect arity " +++ toString fun_arity +++ ", expected " +++ toString st.st_arity) error -> (group_index, groups, fun_defs, td_infos, modules, heaps, error) #! fun = { fun - & fun_symb = fun_ident + & fun_ident = fun_ident , fun_type = Yes st } #! fun_defs = { fun_defs & [fun_index] = fun } -> (group_index, groups, fun_defs, td_infos, modules, heaps, error) - //---> ("update_icl_function, TransformedBody", fun.fun_symb, fun_index, st) + //---> ("update_icl_function, TransformedBody", fun.fun_ident, fun_index, st) GeneratedBody // derived case #! (TransformedBody {tb_args, tb_rhs}, td_infos, modules, heaps, error) @@ -1846,7 +1846,7 @@ where # group = {group_members=[fun_index]} -> (inc group_index, [group:groups], fun_defs, td_infos, modules, heaps, error) - //---> ("update_icl_function, GeneratedBody", fun.fun_symb, fun_index, st) + //---> ("update_icl_function, GeneratedBody", fun.fun_ident, fun_index, st) _ -> abort "update_icl_function: generic case body\n" // build wrapping instance for the generic case function @@ -1864,16 +1864,16 @@ where // module as the instance itself build_instance_member module_index gencase st fun_info heaps - # {gc_name, gc_pos, gc_type_cons, gc_kind, gc_body=GCB_FunIndex fun_index} = gencase + # {gc_ident, gc_pos, gc_type_cons, gc_kind, gc_body=GCB_FunIndex fun_index} = gencase #! arg_var_names = ["x" +++ toString i \\ i <- [1..st.st_arity]] #! (arg_var_exprs, arg_vars, heaps) = buildVarExprs arg_var_names heaps #! (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty heaps.hp_expression_heap #! heaps = {heaps & hp_expression_heap = hp_expression_heap} - #! fun_name = genericIdentToFunIdent gc_name gc_type_cons + #! fun_name = genericIdentToFunIdent gc_ident gc_type_cons #! expr = App { app_symb = - { symb_name=fun_name + { symb_ident=fun_name , symb_kind=SK_Function {glob_module=module_index, glob_object=fun_index} } , app_args = arg_var_exprs @@ -1882,20 +1882,20 @@ where #! (st, heaps) = fresh_symbol_type st heaps - #! memfun_name = genericIdentToMemberIdent gc_name gc_kind + #! memfun_name = genericIdentToMemberIdent gc_ident gc_kind #! (fun_ds, fun_info) = buildFunAndGroup memfun_name arg_vars expr (Yes st) gs_main_module gc_pos fun_info = (fun_ds, fun_info, heaps) build_class_instance class_index gencase member_fun_ds ins_type (ins_index, instances) - # {gc_pos, gc_name, gc_kind} = gencase + # {gc_pos, gc_ident, gc_kind} = gencase - #! class_name = genericIdentToClassIdent gc_name gc_kind - #! class_ds = {ds_index = class_index, ds_arity=1, ds_ident=class_name} + #! class_ident = genericIdentToClassIdent gc_ident gc_kind + #! class_ds = {ds_index = class_index, ds_arity=1, ds_ident=class_ident} #! ins = { ins_class = {glob_module=gs_main_module, glob_object=class_ds} - , ins_ident = class_name + , ins_ident = class_ident , ins_type = ins_type , ins_members = {member_fun_ds} , ins_specials = SP_None @@ -1925,12 +1925,12 @@ buildGenericCaseBody :: , !*Heaps , !*ErrorAdmin ) -buildGenericCaseBody main_module_index gc=:{gc_name, gc_pos, gc_generic, gc_type_cons=TypeConsSymb {type_name,type_index}} st predefs td_infos modules heaps error +buildGenericCaseBody main_module_index gc=:{gc_ident, gc_pos, gc_generic, gc_type_cons=TypeConsSymb {type_ident,type_index}} st predefs td_infos modules heaps error // get all the data we need #! (gen_def, modules) = modules ! [gc_generic.gi_module].com_generic_defs.[gc_generic.gi_index] - //---> ("buildGenericCaseBody for", gc_name, type_name, st) + //---> ("buildGenericCaseBody for", gc_ident, type_ident, st) #! (td_info=:{tdi_gen_rep}, td_infos) = td_infos ! [type_index.glob_module, type_index.glob_object] # (gen_type_rep=:{gtr_iso, gtr_type}) = case tdi_gen_rep of @@ -1966,15 +1966,15 @@ where build_generic_info_arg heaps=:{hp_var_heap} // generic arg is never referenced in the generated body #! (fv_info_ptr, hp_var_heap) = newPtr VI_Empty hp_var_heap - #! fv = {fv_count = 0, fv_name = makeIdent "geninfo", fv_info_ptr = fv_info_ptr, fv_def_level = NotALevel} + #! fv = {fv_count = 0, fv_ident = makeIdent "geninfo", fv_info_ptr = fv_info_ptr, fv_def_level = NotALevel} = (fv, {heaps & hp_var_heap = hp_var_heap}) - build_arg_vars {gen_name, gen_vars, gen_type} td_args heaps + build_arg_vars {gen_ident, gen_vars, gen_type} td_args heaps #! generated_arg_names - = [ gen_name.id_name +++ atv_variable.tv_name.id_name \\ {atv_variable} <- td_args] + = [ gen_ident.id_name +++ atv_variable.tv_ident.id_name \\ {atv_variable} <- td_args] #! (generated_arg_exprs, generated_arg_vars, heaps) = buildVarExprs - [ gen_name.id_name +++ atv_variable.tv_name.id_name \\ {atv_variable} <- td_args] + [ gen_ident.id_name +++ atv_variable.tv_ident.id_name \\ {atv_variable} <- td_args] heaps #! (original_arg_exprs, original_arg_vars, heaps) = buildVarExprs @@ -1984,7 +1984,7 @@ where // adaptor that converts a function for the generic representation into a // function for the type itself - build_adaptor_expr {gc_name, gc_pos} {gen_type, gen_vars, gen_info_ptr} {gtr_iso} (modules, td_infos, heaps, error) + build_adaptor_expr {gc_ident, gc_pos} {gen_type, gen_vars, gen_info_ptr} {gtr_iso} (modules, td_infos, heaps, error) #! (var_kinds, heaps) = get_var_kinds gen_info_ptr heaps #! non_gen_var_kinds = drop (length gen_vars) var_kinds @@ -2045,9 +2045,9 @@ where = ((non_gen_var, expr), heaps) // generic function specialzied to the generic representation of the type - build_specialized_expr {gc_name, gc_pos, gc_generic} gtr_type td_args generated_arg_exprs state + build_specialized_expr {gc_ident, gc_pos, gc_generic} gtr_type td_args generated_arg_exprs state #! spec_env = [(atv_variable, expr) \\ {atv_variable} <- td_args & expr <- generated_arg_exprs] - = specializeGeneric gc_generic gtr_type spec_env gc_name gc_pos main_module_index predefs state + = specializeGeneric gc_generic gtr_type spec_env gc_ident gc_pos main_module_index predefs state // the body expression build_body_expr adaptor_expr specialized_expr [] @@ -2056,9 +2056,9 @@ where = (adaptor_expr @ [specialized_expr]) @ original_arg_exprs -//buildGenericCaseBody main_module_index {gc_name,gc_pos, gc_generic, gc_type_cons=TypeConsSymb {type_index}} st predefs td_infos modules heaps error -buildGenericCaseBody main_module_index {gc_name,gc_pos} st predefs td_infos modules heaps error - # error = reportError gc_name gc_pos "cannot specialize to this type" error +//buildGenericCaseBody main_module_index {gc_ident,gc_pos, gc_generic, gc_type_cons=TypeConsSymb {type_index}} st predefs td_infos modules heaps error +buildGenericCaseBody main_module_index {gc_ident,gc_pos} st predefs td_infos modules heaps error + # error = reportError gc_ident gc_pos "cannot specialize to this type" error = (TransformedBody {tb_args=[], tb_rhs=EE}, td_infos, modules, heaps, error) //**************************************************************************************** @@ -2108,8 +2108,8 @@ where where convert_function :: !FunDef (!*Modules, !*Heaps, !*ErrorAdmin) -> (!FunDef, (!*Modules, !*Heaps, !*ErrorAdmin)) - convert_function fun=:{fun_type=Yes symbol_type=:{st_context}, fun_symb, fun_pos} st - # (has_converted, st_context, st) = convert_contexts fun_symb fun_pos st_context st + convert_function fun=:{fun_type=Yes symbol_type=:{st_context}, fun_ident, fun_pos} st + # (has_converted, st_context, st) = convert_contexts fun_ident fun_pos st_context st | has_converted # fun = {fun & fun_type = Yes {symbol_type & st_context = st_context}} = (fun, st) @@ -2164,14 +2164,14 @@ where = (common_defs, modules, (heaps, error)) where - convert_class _ class_def=:{class_name, class_pos, class_context} st - # (ok, class_context, st) = convert_contexts class_name class_pos class_context st + convert_class _ class_def=:{class_ident, class_pos, class_context} st + # (ok, class_context, st) = convert_contexts class_ident class_pos class_context st | ok # class_def={class_def & class_context = class_context} = (class_def, st) = (class_def, st) - convert_member _ member_def=:{me_symb, me_pos, me_type=me_type=:{st_context}} st - # (ok, st_context, st) = convert_contexts me_symb me_pos st_context st + convert_member _ member_def=:{me_ident, me_pos, me_type=me_type=:{st_context}} st + # (ok, st_context, st) = convert_contexts me_ident me_pos st_context st | ok # member_def={member_def & me_type = {me_type & st_context = st_context}} = (member_def, st) @@ -2189,8 +2189,8 @@ where = updateArraySt convert_dcl_function dcl_functions (modules, heaps, error) = (dcl_functions, modules, (heaps, error)) where - convert_dcl_function _ fun=:{ft_type=ft_type=:{st_context}, ft_symb, ft_pos} st - # (ok, st_context, st) = convert_contexts ft_symb ft_pos st_context st + convert_dcl_function _ fun=:{ft_type=ft_type=:{st_context}, ft_ident, ft_pos} st + # (ok, st_context, st) = convert_contexts ft_ident ft_pos st_context st | ok # fun={fun & ft_type = {ft_type & st_context = st_context}} = (fun, st) @@ -2259,7 +2259,7 @@ specializeGeneric :: -> ( !Expression , !(!*TypeDefInfos, !*Heaps, !*ErrorAdmin) ) -specializeGeneric gen_index type spec_env gen_name gen_pos main_module_index predefs (td_infos, heaps, error) +specializeGeneric gen_index type spec_env gen_ident gen_pos main_module_index predefs (td_infos, heaps, error) #! heaps = set_tvs spec_env heaps #! (expr, (td_infos, heaps, error)) = specialize type (td_infos, heaps, error) @@ -2296,7 +2296,7 @@ where #! (generic_info_expr, heaps) = buildFunApp main_module_index cons_info_ds [] heaps #! (expr, heaps) = buildGenericApp - gen_index.gi_module gen_index.gi_index gen_name + gen_index.gi_module gen_index.gi_index gen_ident (KindArrow [KindConst]) [generic_info_expr, arg_expr] heaps = (expr, (td_infos, heaps, error)) @@ -2307,14 +2307,14 @@ where #! (generic_info_expr, heaps) = buildFunApp main_module_index field_info_ds [] heaps #! (expr, heaps) = buildGenericApp - gen_index.gi_module gen_index.gi_index gen_name + gen_index.gi_module gen_index.gi_index gen_ident (KindArrow [KindConst]) [generic_info_expr, arg_expr] heaps = (expr, (td_infos, heaps, error)) specialize type (td_infos, heaps, error) - #! error = reportError gen_name gen_pos "cannot specialize " error + #! error = reportError gen_ident gen_pos "cannot specialize " error = (EE, (td_infos, heaps, error)) @@ -2329,7 +2329,7 @@ where # arg_exprs = SwitchGenericInfo [generic_info_expr:arg_exprs] arg_exprs #! (expr, heaps) - = buildGenericApp gen_index.gi_module gen_index.gi_index gen_name kind arg_exprs heaps + = buildGenericApp gen_index.gi_module gen_index.gi_index gen_ident kind arg_exprs heaps = (expr, (td_infos, heaps, error)) @@ -2468,12 +2468,12 @@ where ) // generic type var is replaced with a fresh one - subst_gtv {tv_info_ptr, tv_name} th_vars - # (tv, th_vars) = freshTypeVar (postfixIdent tv_name postfix) th_vars + subst_gtv {tv_info_ptr, tv_ident} th_vars + # (tv, th_vars) = freshTypeVar (postfixIdent tv_ident postfix) th_vars = (tv, writePtr tv_info_ptr (TVI_Type (TV tv)) th_vars) - subst_attr (TA_Var {av_name, av_info_ptr}) th_attrs - # (av, th_attrs) = freshAttrVar (postfixIdent av_name postfix) th_attrs + subst_attr (TA_Var {av_ident, av_info_ptr}) th_attrs + # (av, th_attrs) = freshAttrVar (postfixIdent av_ident postfix) th_attrs = (TA_Var av, writePtr av_info_ptr (AVI_Attr (TA_Var av)) th_attrs) //---> ("(2) writePtr av_info_ptr", ptrToInt av_info_ptr, av) subst_attr TA_Multi th = (TA_Multi, th) @@ -2656,13 +2656,13 @@ instance mapTypeSt TypeContext where freshTypeVar :: !Ident !*TypeVarHeap -> (!TypeVar, !*TypeVarHeap) freshTypeVar name th_vars # (info_ptr, th_vars) = newPtr TVI_Empty th_vars - = ({tv_name = name, tv_info_ptr = info_ptr}, th_vars) + = ({tv_ident = name, tv_info_ptr = info_ptr}, th_vars) // allocate fresh attribute variable freshAttrVar :: !Ident !*AttrVarHeap -> (!AttributeVar, !*AttrVarHeap) freshAttrVar name th_attrs # (info_ptr, th_attrs) = newPtr AVI_Empty th_attrs - = ({av_name = name, av_info_ptr = info_ptr}, th_attrs) + = ({av_ident = name, av_info_ptr = info_ptr}, th_attrs) // take a fresh copy of a SymbolType @@ -2773,7 +2773,7 @@ where #! (av_info, th_attrs) = readPtr av_info_ptr th_attrs #! av = case av_info of AVI_AttrVar new_ptr -> {av & av_info_ptr = new_ptr} - //---> ("fresh attr var", av.av_name, ptrToInt av_info_ptr, ptrToInt new_ptr) + //---> ("fresh attr var", av.av_ident, ptrToInt av_info_ptr, ptrToInt new_ptr) _ -> abort ("freshSymbolType, invalid av_info\n" ---> av_info) = ( av, {th & th_attrs = th_attrs}) @@ -3208,7 +3208,7 @@ makeFunction ident fun_index group_index arg_vars body_expr opt_sym_type main_dc = abort "makeFunction: free_vars is not empty\n" #! fun_def = - { fun_symb = ident + { fun_ident = ident , fun_arity = length arg_vars , fun_priority = NoPrio , fun_body = TransformedBody {tb_args = arg_vars, tb_rhs = body_expr } @@ -3252,8 +3252,8 @@ where build_free_var :: !String !*Heaps -> (!FreeVar, !*Heaps) build_free_var name heaps=:{hp_var_heap} # (var_info_ptr, hp_var_heap) = newPtr VI_Empty hp_var_heap - # var_name = { id_name = name, id_info = nilPtr } - # free_var = { fv_def_level = NotALevel, fv_count = 0, fv_info_ptr = var_info_ptr, fv_name = var_name} + # var_ident = { id_name = name, id_info = nilPtr } + # free_var = { fv_def_level = NotALevel, fv_count = 0, fv_info_ptr = var_info_ptr, fv_ident = var_ident} = (free_var, {heaps & hp_var_heap = hp_var_heap}) /* @@ -3292,8 +3292,8 @@ where build_free_var :: !String !*Heaps -> (!FreeVar, !*Heaps) build_free_var name heaps=:{hp_var_heap} # (var_info_ptr, hp_var_heap) = newPtr VI_Empty hp_var_heap - # var_name = { id_name = name, id_info = nilPtr } - # free_var = { fv_def_level = NotALevel, fv_count = 0, fv_info_ptr = var_info_ptr, fv_name = var_name} + # var_ident = { id_name = name, id_info = nilPtr } + # free_var = { fv_def_level = NotALevel, fv_count = 0, fv_info_ptr = var_info_ptr, fv_ident = var_ident} = (free_var, {heaps & hp_var_heap = hp_var_heap}) */ @@ -3332,7 +3332,7 @@ buildConsApp cons_mod {ds_ident, ds_index, ds_arity} arg_exprs heaps=:{hp_expres # cons_glob = {glob_module = cons_mod, glob_object = ds_index} # expr = App { app_symb = { - symb_name = ds_ident, + symb_ident = ds_ident, symb_kind = SK_Constructor cons_glob }, app_args = arg_exprs, @@ -3347,7 +3347,7 @@ buildFunApp fun_mod {ds_ident, ds_index} arg_exprs heaps=:{hp_expression_heap} # fun_glob = {glob_module = fun_mod, glob_object = ds_index} # expr = App { app_symb = { - symb_name = ds_ident, + symb_ident = ds_ident, symb_kind = SK_Function fun_glob }, app_args = arg_exprs, @@ -3368,12 +3368,12 @@ buildPredefFunApp predef_index args predefs heaps buildGenericApp :: !Index !Index !Ident !TypeKind ![Expression] !*Heaps -> (!Expression, !*Heaps) -buildGenericApp gen_module gen_index gen_name kind arg_exprs heaps=:{hp_expression_heap} +buildGenericApp gen_module gen_index gen_ident kind arg_exprs heaps=:{hp_expression_heap} # (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty hp_expression_heap # glob_index = {glob_module = gen_module, glob_object = gen_index} # expr = App { app_symb = { - symb_name = gen_name, + symb_ident = gen_ident, symb_kind = SK_Generic glob_index kind }, app_args = arg_exprs, @@ -3388,7 +3388,7 @@ buildPredefConsApp predef_index args predefs heaps=:{hp_expression_heap} # pds_ident = predefined_idents.[predef_index] # global_index = {glob_module = pds_module, glob_object = pds_def} # symb_ident = - { symb_name = pds_ident + { symb_ident = pds_ident , symb_kind = SK_Constructor global_index } # (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty hp_expression_heap @@ -3453,11 +3453,11 @@ buildVarExpr :: buildVarExpr name heaps=:{hp_var_heap, hp_expression_heap} # (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty hp_expression_heap # (var_info_ptr, hp_var_heap) = newPtr VI_Empty hp_var_heap - # var_name = makeIdent name - # var = Var {var_name = var_name, var_expr_ptr = expr_info_ptr, var_info_ptr = var_info_ptr } + # var_ident = makeIdent name + # var = Var {var_ident = var_ident, var_expr_ptr = expr_info_ptr, var_info_ptr = var_info_ptr } # hp_var_heap = writePtr var_info_ptr (VI_Expression var) hp_var_heap # heaps = { heaps & hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap } - # fv = {fv_count = 1/* if 0, trans crashes*/, fv_name = var_name, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel} + # fv = {fv_count = 1/* if 0, trans crashes*/, fv_ident = var_ident, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel} = (var, fv, heaps) buildVarExprs [] heaps = ([], [], heaps) @@ -3667,12 +3667,12 @@ instance == FunCall where (==) (FunCall x _) (FunCall y _) = x == y collectCalls :: !Index !Expression -> [FunCall] collectCalls current_module expr = removeDup (foldExpr get_call expr []) where - get_call (App {app_symb={symb_kind=SK_Function {glob_module,glob_object}, symb_name}}) indexes + get_call (App {app_symb={symb_kind=SK_Function {glob_module,glob_object}, symb_ident}}) indexes | glob_module == current_module = [FunCall glob_object NotALevel : indexes] - //---> ("collect call ", symb_name, glob_object) + //---> ("collect call ", symb_ident, glob_object) = indexes - //---> ("do not collect call ", symb_name, glob_module, glob_object) + //---> ("do not collect call ", symb_ident, glob_module, glob_object) get_call _ indexes = indexes // collects variables and computes the refernce counts @@ -3687,8 +3687,8 @@ collectVars expr arg_vars # arg_vars = [ {v & fv_count = 0} \\ v <- arg_vars] = foldExpr collect_vars expr (arg_vars, [], []) where - collect_vars (Var {var_name, var_info_ptr}) (arg_vars, local_vars, free_vars) - # var = {fv_name = var_name, fv_count = 1, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel} + collect_vars (Var {var_ident, var_info_ptr}) (arg_vars, local_vars, free_vars) + # var = {fv_ident = var_ident, fv_count = 1, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel} # (added, arg_vars) = add_var var arg_vars | added = (arg_vars, local_vars, free_vars) diff --git a/frontend/genericsupport.icl b/frontend/genericsupport.icl index ba2877d..8b62503 100644 --- a/frontend/genericsupport.icl +++ b/frontend/genericsupport.icl @@ -83,8 +83,8 @@ postfixIdent :: !Ident !String -> Ident postfixIdent {id_name} postfix = makeIdent (id_name +++ postfix) genericIdentToClassIdent :: !Ident !TypeKind -> Ident -genericIdentToClassIdent gen_name kind - = postfixIdent gen_name ("_" +++ kind_to_str kind) +genericIdentToClassIdent gen_ident kind + = postfixIdent gen_ident ("_" +++ kind_to_str kind) where kind_to_str KindConst = "s" kind_to_str (KindArrow kinds) @@ -94,15 +94,15 @@ where kinds_to_str [k:ks] = "o" +++ (kind_to_str k) +++ "c" +++ kinds_to_str ks genericIdentToMemberIdent :: !Ident !TypeKind -> Ident -genericIdentToMemberIdent gen_name kind - = genericIdentToClassIdent gen_name kind +genericIdentToMemberIdent gen_ident kind + = genericIdentToClassIdent gen_ident kind genericIdentToFunIdent :: !Ident !TypeCons -> Ident -genericIdentToFunIdent gen_name type_cons - = postfixIdent gen_name ("_" +++ type_cons_to_str type_cons) +genericIdentToFunIdent gen_ident type_cons + = postfixIdent gen_ident ("_" +++ type_cons_to_str type_cons) where - type_cons_to_str (TypeConsSymb {type_name}) = toString type_name + type_cons_to_str (TypeConsSymb {type_ident}) = toString type_ident type_cons_to_str (TypeConsBasic bt) = toString bt type_cons_to_str TypeConsArrow = "ARROW" - type_cons_to_str (TypeConsVar tv) = tv.tv_name.id_name + type_cons_to_str (TypeConsVar tv) = tv.tv_ident.id_name
\ No newline at end of file diff --git a/frontend/main.icl b/frontend/main.icl index 9b91d14..c11055a 100644 --- a/frontend/main.icl +++ b/frontend/main.icl @@ -114,9 +114,9 @@ DoCommand ['c':_] argument symbol_heap ms DoCommand ['m':_] argument symbol_heap ms # (file_name, rest_input) = SplitAtLayoutChar (dropWhile isSpace argument) - # mod_name = toString file_name + # mod_ident = toString file_name # dcl_cache=empty_cache symbol_heap - # (proj, ms) = makeProject { proj_main_module=mod_name, + # (proj, ms) = makeProject { proj_main_module=mod_ident, proj_modules=NoModules, proj_cache=dcl_cache} ms = (False, proj.proj_cache.hash_table.hte_symbol_heap, ms) @@ -169,8 +169,8 @@ where (word, rest_input) = SplitAtLayoutChar xs compileModule :: String *DclCache *MainState -> *(!Optional InterMod,!*DclCache,!*MainState); -compileModule mod_name dcl_cache ms - # (mod_ident, hash_table) = putIdentInHashTable mod_name IC_Module dcl_cache.hash_table +compileModule mod_ident dcl_cache ms + # (mod_ident, hash_table) = putIdentInHashTable mod_ident IC_Module dcl_cache.hash_table dcl_cache = {dcl_cache & hash_table=hash_table} = loadModule mod_ident.boxed_ident dcl_cache ms @@ -308,7 +308,7 @@ where | show_types = show_component funs show_types fun_defs (file <<< '\n' <<< fun_def) = show_component funs show_types fun_defs (file <<< fun_def) -// = show_component funs show_types fun_defs (file <<< fun_def.fun_symb) +// = show_component funs show_types fun_defs (file <<< fun_def.fun_ident) showComponents2 :: !{! Group} !Int !*{# FunDef} !{! ConsClasses} !*File -> (!*{# FunDef},!*File) showComponents2 comps comp_index fun_defs acc_args file @@ -321,7 +321,7 @@ where = (fun_defs, file <<< '\n') show_component [fun:funs] fun_defs acc_args file #! fd = fun_defs.[fun] - # file = show_accumulating_arguments acc_args.[fun].cc_args (file <<< fd.fun_symb <<< '.' <<< fun <<< " (") + # file = show_accumulating_arguments acc_args.[fun].cc_args (file <<< fd.fun_ident <<< '.' <<< fun <<< " (") = show_component funs fun_defs acc_args (file <<< ") ") show_accumulating_arguments [ cc : ccs] file @@ -355,7 +355,7 @@ where #! fun_def = fun_defs.[fun] # properties = { form_properties = cAttributed bitor cAnnotated, form_attr_position = No } (Yes ftype) = fun_def.fun_type - = show_types funs fun_defs (file <<< fun_def.fun_symb <<< " :: " <:: (properties, ftype) <<< '\n' ) + = show_types funs fun_defs (file <<< fun_def.fun_ident <<< " :: " <:: (properties, ftype) <<< '\n' ) */ converFileToListOfStrings file_name files error diff --git a/frontend/mergecases.icl b/frontend/mergecases.icl index f99dc59..2146fff 100644 --- a/frontend/mergecases.icl +++ b/frontend/mergecases.icl @@ -198,9 +198,9 @@ where (expr, us) = unfold expr ui us = (expr, us.us_var_heap, us.us_symbol_heap) - new_variable fv=:{fv_name, fv_info_ptr} var_heap + new_variable fv=:{fv_ident, fv_info_ptr} var_heap # (new_info_ptr, var_heap) = newPtr VI_Empty var_heap - = ({fv & fv_info_ptr = new_info_ptr}, var_heap <:= (fv_info_ptr, VI_Variable fv_name new_info_ptr)) + = ({fv & fv_info_ptr = new_info_ptr}, var_heap <:= (fv_info_ptr, VI_Variable fv_ident new_info_ptr)) rebuild_let_expression lad expr var_heap expr_heap # (rev_let_lazy_binds, var_heap) = foldSt renew_let_var lad.let_lazy_binds ([], var_heap) @@ -365,8 +365,8 @@ where (expr, us) = unfold expr ui us = (expr, us.us_var_heap, us.us_symbol_heap) where - build_aliases [var1 : vars1] [ {fv_name,fv_info_ptr} : vars2 ] var_heap - = build_aliases vars1 vars2 (writePtr var1.fv_info_ptr (VI_Variable fv_name fv_info_ptr) var_heap) + build_aliases [var1 : vars1] [ {fv_ident,fv_info_ptr} : vars2 ] var_heap + = build_aliases vars1 vars2 (writePtr var1.fv_info_ptr (VI_Variable fv_ident fv_info_ptr) var_heap) build_aliases [] [] var_heap = var_heap diff --git a/frontend/overloading.icl b/frontend/overloading.icl index 668b739..bea32b3 100644 --- a/frontend/overloading.icl +++ b/frontend/overloading.icl @@ -106,8 +106,8 @@ uniqueError symbol types err <<< "\" uniqueness specification of instance conflicts with current application " <:: (format, types, Yes initialTypeVarBeautifulizer) <<< '\n'} -unboxError class_name type err - # err = errorHeading ("Overloading error of "+++class_name+++" class") err +unboxError class_ident type err + # err = errorHeading ("Overloading error of "+++class_ident+++" class") err format = { form_properties = cNoProperties, form_attr_position = No } = { err & ea_file = err.ea_file <<< ' ' <:: (format, type, Yes initialTypeVarBeautifulizer) <<< " instance cannot be unboxed\n"} @@ -120,9 +120,9 @@ overloadingError op_symb err -> str+++" [line "+++toString line_nr+++"]" = { err & ea_file = err.ea_file <<< " internal overloading of \"" <<< str <<< "\" could not be solved\n" } -abstractTypeInDynamicError td_name err=:{ea_ok} +abstractTypeInDynamicError td_ident err=:{ea_ok} # err = errorHeading "Implementation restriction" err - = { err & ea_file = err.ea_file <<< (" derived abstract type '" +++ toString td_name +++ "' not permitted in a dynamic") <<< '\n' } + = { err & ea_file = err.ea_file <<< (" derived abstract type '" +++ toString td_ident +++ "' not permitted in a dynamic") <<< '\n' } typeCodeInDynamicError err=:{ea_ok} # err = errorHeading "Overloading error (warning for now)" err @@ -193,7 +193,7 @@ where = reduce_context {tc & tc_class = TCClass gtc_class} defs instance_info new_contexts special_instances type_pattern_vars heaps coercion_env predef_symbols error reduce_context {tc_class=TCClass class_symb=:{glob_object={ds_index},glob_module},tc_types} defs instance_info new_contexts special_instances type_pattern_vars heaps coercion_env predef_symbols error - # {class_members,class_context,class_args,class_name} = defs.[glob_module].com_class_defs.[ds_index] + # {class_members,class_context,class_args,class_ident} = defs.[glob_module].com_class_defs.[ds_index] | size class_members > 0 # class_instances = instance_info.[glob_module].[ds_index] # ({glob_module,glob_object}, contexts, uni_ok, (var_heap, type_heaps), coercion_env) = find_instance tc_types class_instances defs heaps coercion_env @@ -228,9 +228,9 @@ where # rcs_class_context = { rc_class = class_symb, rc_inst_module = NoIndex, rc_inst_members = {}, rc_types = tc_types, rc_red_contexts = [] } | glob_module <> NotFound = ({ rcs_class_context = rcs_class_context, rcs_constraints_contexts = []}, new_contexts, - special_instances, type_pattern_vars, (var_heap, type_heaps), coercion_env, predef_symbols, uniqueError class_name tc_types error) + special_instances, type_pattern_vars, (var_heap, type_heaps), coercion_env, predef_symbols, uniqueError class_ident tc_types error) = ({ rcs_class_context = rcs_class_context, rcs_constraints_contexts = []}, new_contexts, - special_instances, type_pattern_vars, (var_heap, type_heaps), coercion_env, predef_symbols, instanceError class_name tc_types error) + special_instances, type_pattern_vars, (var_heap, type_heaps), coercion_env, predef_symbols, instanceError class_ident tc_types error) # (constraints, new_contexts, special_instances, type_pattern_vars, heaps, coercion_env, predef_symbols, error) = reduce_contexts_in_constraints tc_types class_args class_context defs instance_info new_contexts special_instances type_pattern_vars heaps coercion_env predef_symbols error @@ -543,11 +543,11 @@ where | cPredefinedModuleIndex == glob_module = error - #! ({td_name,td_rhs}) + #! ({td_ident,td_rhs}) = defs.[glob_module].com_type_defs.[glob_object] = case td_rhs of - AbstractType _ -> abstractTypeInDynamicError td_name error - AbstractSynType _ _ -> abstractTypeInDynamicError td_name error + AbstractType _ -> abstractTypeInDynamicError td_ident error + AbstractSynType _ _ -> abstractTypeInDynamicError td_ident error _ -> error reduce_TC_context type_code_class tc_type new_contexts special_instances type_pattern_vars var_heap type_heaps error @@ -625,8 +625,8 @@ addGlobalTCInstance type_of_TC (next_member_index, instances=:[inst : insts]) addGlobalTCInstance type_of_TC (next_member_index, []) = (next_member_index, (inc next_member_index, [{ gtci_index = next_member_index, gtci_type = type_of_TC }])) -tryToExpandTypeSyn defs type cons_id=:{type_name,type_index={glob_object,glob_module}} type_args type_heaps - # {td_name,td_rhs,td_args,td_attribute} = defs.[glob_module].com_type_defs.[glob_object] +tryToExpandTypeSyn defs type cons_id=:{type_ident,type_index={glob_object,glob_module}} type_args type_heaps + # {td_ident,td_rhs,td_args,td_attribute} = defs.[glob_module].com_type_defs.[glob_object] = case td_rhs of SynType {at_type} # (_, expanded_type, type_heaps) = substituteType td_attribute TA_Multi td_args type_args at_type type_heaps @@ -831,7 +831,7 @@ where (glob_fun, os_type_heaps) = trySpecializedInstances oc_context oc_specials os_type_heaps | FoundObject glob_fun # os_symbol_heap = os_symbol_heap <:= (over_info_ptr, EI_Instance {glob_module = glob_fun.glob_module, glob_object = - { ds_ident = oc_symbol.symb_name, ds_arity = 0, ds_index = glob_fun.glob_object }} []) + { ds_ident = oc_symbol.symb_ident, ds_arity = 0, ds_index = glob_fun.glob_object }} []) = (reduced_calls, new_contexts, coercion_env, type_pattern_vars, { os & os_type_heaps = os_type_heaps, os_symbol_heap = os_symbol_heap }) | otherwise # (class_applications, new_contexts, os_special_instances, type_pattern_vars, @@ -885,8 +885,8 @@ where selectFromDictionary dict_mod dict_index member_index defs # (RecordType {rt_fields}) = defs.[dict_mod].com_type_defs.[dict_index].td_rhs - { fs_name, fs_index } = rt_fields.[member_index] - = { glob_module = dict_mod, glob_object = { ds_ident = fs_name, ds_index = fs_index, ds_arity = 1 }} + { fs_ident, fs_index } = rt_fields.[member_index] + = { glob_module = dict_mod, glob_object = { ds_ident = fs_ident, ds_index = fs_index, ds_arity = 1 }} getDictionaryTypeAndConstructor {glob_module, glob_object = {ds_ident,ds_index}} defs # {class_dictionary} = defs.[glob_module].com_class_defs.[ds_index] @@ -894,19 +894,19 @@ getDictionaryTypeAndConstructor {glob_module, glob_object = {ds_ident,ds_index}} = (class_dictionary, rt_constructor) convertOverloadedCall :: !{#CommonDefs} ![TypeContext] !SymbIdent !ExprInfoPtr ![ClassApplication] !(!*Heaps, ![ExprInfoPtr],!*ErrorAdmin) -> (!*Heaps, ![ExprInfoPtr],!*ErrorAdmin) -convertOverloadedCall defs contexts {symb_name,symb_kind = SK_OverloadedFunction {glob_module,glob_object}} expr_ptr [class_appl:class_appls] (heaps,ptrs,error) +convertOverloadedCall defs contexts {symb_ident,symb_kind = SK_OverloadedFunction {glob_module,glob_object}} expr_ptr [class_appl:class_appls] (heaps,ptrs,error) # mem_def = defs.[glob_module].com_member_defs.[glob_object] (class_exprs, heaps_and_ptrs) = convertClassApplsToExpressions defs contexts class_appls (heaps, ptrs) (inst_expr, (heaps, ptrs)) = adjust_member_application defs contexts mem_def class_appl class_exprs heaps_and_ptrs = ({ heaps & hp_expression_heap = heaps.hp_expression_heap <:= (expr_ptr, inst_expr)}, ptrs, error) where - adjust_member_application defs contexts {me_symb,me_offset,me_class} (CA_Instance red_contexts) class_exprs heaps_and_ptrs + adjust_member_application defs contexts {me_ident,me_offset,me_class} (CA_Instance red_contexts) class_exprs heaps_and_ptrs # ({glob_module,glob_object}, red_contexts) = find_instance_of_member me_class me_offset red_contexts (exprs, heaps_and_ptrs) = convertClassApplsToExpressions defs contexts red_contexts heaps_and_ptrs class_exprs = exprs ++ class_exprs - = (EI_Instance { glob_module = glob_module, glob_object = { ds_ident = me_symb, ds_arity = length class_exprs, ds_index = glob_object }} class_exprs, + = (EI_Instance { glob_module = glob_module, glob_object = { ds_ident = me_ident, ds_arity = length class_exprs, ds_index = glob_object }} class_exprs, heaps_and_ptrs) - adjust_member_application defs contexts {me_symb,me_offset,me_class={glob_module,glob_object}} (CA_Context tc) class_exprs (heaps=:{hp_type_heaps}, ptrs) + adjust_member_application defs contexts {me_ident,me_offset,me_class={glob_module,glob_object}} (CA_Context tc) class_exprs (heaps=:{hp_type_heaps}, ptrs) # (class_context, address, hp_type_heaps) = determineContextAddress contexts defs tc hp_type_heaps {class_dictionary={ds_index,ds_ident}} = defs.[glob_module].com_class_defs.[glob_object] selector = selectFromDictionary glob_module ds_index me_offset defs @@ -928,20 +928,20 @@ where find_instance_of_member_in_constraints me_class me_offset [] = abort "Error in module overloading: find_instance_of_member_in_constraints\n" // AA.. -convertOverloadedCall defs contexts symbol=:{symb_name, symb_kind = SK_Generic gen_glob kind} expr_ptr class_appls (heaps, expr_info_ptrs, error) +convertOverloadedCall defs contexts symbol=:{symb_ident, symb_kind = SK_Generic gen_glob kind} expr_ptr class_appls (heaps, expr_info_ptrs, error) #! (opt_member_glob, hp_generic_heap) = getGenericMember gen_glob kind defs heaps.hp_generic_heap #! heaps = { heaps & hp_generic_heap = hp_generic_heap } = case opt_member_glob of No - # error = checkError ("no generic instances of " +++ toString symb_name +++ " for kind") kind error + # error = checkError ("no generic instances of " +++ toString symb_ident +++ " for kind") kind error -> (heaps, expr_info_ptrs, error) Yes member_glob -> convertOverloadedCall defs contexts {symbol & symb_kind = SK_OverloadedFunction member_glob} expr_ptr class_appls (heaps, expr_info_ptrs, error) // ..AA -convertOverloadedCall defs contexts {symb_name,symb_kind = SK_TypeCode} expr_info_ptr class_appls (heaps, ptrs, error) +convertOverloadedCall defs contexts {symb_ident,symb_kind = SK_TypeCode} expr_info_ptr class_appls (heaps, ptrs, error) # (class_expressions, (heaps, ptrs)) = convertClassApplsToExpressions defs contexts class_appls (heaps, ptrs) = ({ heaps & hp_expression_heap = heaps.hp_expression_heap <:= (expr_info_ptr, EI_TypeCodes (map expressionToTypeCodeExpression class_expressions))}, ptrs, error) -convertOverloadedCall defs contexts {symb_name} expr_info_ptr appls (heaps,ptrs, error) +convertOverloadedCall defs contexts {symb_ident} expr_info_ptr appls (heaps,ptrs, error) # (class_expressions, (heaps, ptrs)) = convertClassApplsToExpressions defs contexts appls (heaps,ptrs) = ({ heaps & hp_expression_heap = heaps.hp_expression_heap <:= (expr_info_ptr, EI_Context class_expressions)}, ptrs, error) @@ -1017,7 +1017,7 @@ where # mem_offset = dec mem_offset {ds_ident,ds_index} = ins_members.[mem_offset] mem_expr = App { app_symb = { - symb_name = ds_ident, + symb_ident = ds_ident, symb_kind = SK_Function { glob_object = ds_index, glob_module = mod_index } }, app_args = class_arguments, @@ -1026,7 +1026,7 @@ where build_dictionary class_symbol instance_types dictionary_args defs expr_heap ptrs # (dict_type, dict_cons) = getDictionaryTypeAndConstructor class_symbol defs - record_symbol = { symb_name = dict_cons.ds_ident, + record_symbol = { symb_ident = dict_cons.ds_ident, symb_kind = SK_Constructor {glob_module = class_symbol.glob_module, glob_object = dict_cons.ds_index} } dict_type_symbol = MakeTypeSymbIdent {glob_module = class_symbol.glob_module, glob_object = dict_type.ds_index} dict_type.ds_ident dict_type.ds_arity @@ -1035,18 +1035,18 @@ where rc_record = App { app_symb = record_symbol, app_args = dictionary_args, app_info_ptr = app_info_ptr } = (rc_record, expr_heap, [app_info_ptr : ptrs]) - bind_shared_dictionary nr_of_members dict=:(Let {let_expr=App {app_symb={symb_name}, app_info_ptr}}) (binds, types, rev_dicts, var_heap, expr_heap) + bind_shared_dictionary nr_of_members dict=:(Let {let_expr=App {app_symb={symb_ident}, app_info_ptr}}) (binds, types, rev_dicts, var_heap, expr_heap) # (EI_DictionaryType class_type, expr_heap) = readPtr app_info_ptr expr_heap (var_info_ptr, var_heap) = newPtr VI_Empty var_heap - fv = { fv_name = symb_name, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel, fv_count = nr_of_members } - var = { var_name = symb_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr } + fv = { fv_ident = symb_ident, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel, fv_count = nr_of_members } + var = { var_ident = symb_ident, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr } = ([{lb_src = dict, lb_dst = fv, lb_position = NoPos } : binds ], [ AttributedType class_type : types ], [Var var : rev_dicts], var_heap, expr_heap) - bind_shared_dictionary nr_of_members dict=:(App {app_symb={symb_name}, app_info_ptr}) (binds, types, rev_dicts, var_heap, expr_heap) + bind_shared_dictionary nr_of_members dict=:(App {app_symb={symb_ident}, app_info_ptr}) (binds, types, rev_dicts, var_heap, expr_heap) # (EI_DictionaryType class_type, expr_heap) = readPtr app_info_ptr expr_heap (var_info_ptr, var_heap) = newPtr VI_Empty var_heap - fv = { fv_name = symb_name, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel, fv_count = nr_of_members } - var = { var_name = symb_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr } + fv = { fv_ident = symb_ident, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel, fv_count = nr_of_members } + var = { var_ident = symb_ident, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr } = ([{lb_src = dict, lb_dst = fv, lb_position = NoPos} : binds ], [ AttributedType class_type : types ], [Var var : rev_dicts], var_heap, expr_heap) bind_shared_dictionary nr_of_members dict (binds, types, rev_dicts, var_heap, expr_heap) = (binds, types, [dict : rev_dicts], var_heap, expr_heap) @@ -1100,8 +1100,8 @@ where getClassVariable :: !Ident !VarInfoPtr !*VarHeap !*ErrorAdmin -> (!Ident, !VarInfoPtr, !*VarHeap, !*ErrorAdmin) getClassVariable symb var_info_ptr var_heap error = case (readPtr var_info_ptr var_heap) of - (VI_ClassVar var_name new_info_ptr count, var_heap) - -> (var_name, new_info_ptr, var_heap <:= (var_info_ptr, VI_ClassVar var_name new_info_ptr (inc count)), error) + (VI_ClassVar var_ident new_info_ptr count, var_heap) + -> (var_ident, new_info_ptr, var_heap <:= (var_info_ptr, VI_ClassVar var_ident new_info_ptr (inc count)), error) (_,var_heap) # (new_info_ptr, var_heap) = newPtr VI_Empty var_heap -> (symb, new_info_ptr, var_heap <:= (var_info_ptr, VI_ClassVar symb new_info_ptr 1), overloadingError symb error) @@ -1117,7 +1117,7 @@ where = (fun_defs, fun_env, symbol_heap, type_code_info, var_heap, error, predef_symbols) update_dynamics [fun:funs] type_pattern_vars fun_defs fun_env symbol_heap type_code_info var_heap error predef_symbols # (fun_def, fun_defs) = fun_defs![fun] - # {fun_body,fun_symb,fun_info} = fun_def + # {fun_body,fun_ident,fun_info} = fun_def # {fi_group_index, fi_dynamics, fi_local_vars} = fun_info | isEmpty fi_dynamics = update_dynamics funs type_pattern_vars fun_defs fun_env symbol_heap type_code_info var_heap error predef_symbols @@ -1152,9 +1152,9 @@ where | ok # (fun_def, fun_defs) = fun_defs![fun_index] (CheckedType st=:{st_context}, fun_env) = fun_env![fun_index] - {fun_body = TransformedBody {tb_args,tb_rhs},fun_info,fun_arity,fun_symb,fun_pos} = fun_def + {fun_body = TransformedBody {tb_args,tb_rhs},fun_info,fun_arity,fun_ident,fun_pos} = fun_def (rev_variables, var_heap) = foldSt determine_class_argument st_context ([], var_heap) - error = setErrorAdmin (newPosition fun_symb fun_pos) error + error = setErrorAdmin (newPosition fun_ident fun_pos) error (type_code_info, symbol_heap, type_pattern_vars, var_heap, error) = convertDynamicTypes fun_info.fi_dynamics (type_code_info, symbol_heap, type_pattern_vars, var_heap, error) @@ -1205,8 +1205,8 @@ where = { id_name = "_v" +++ id_name, id_info = nilPtr } retrieve_class_argument var_info_ptr (args, var_heap) - # (VI_ClassVar var_name new_info_ptr count, var_heap) = readPtr var_info_ptr var_heap - = ([{fv_name = var_name, fv_info_ptr = new_info_ptr, fv_def_level = NotALevel, fv_count = count } : args], var_heap <:= (var_info_ptr, VI_Empty)) + # (VI_ClassVar var_ident new_info_ptr count, var_heap) = readPtr var_info_ptr var_heap + = ([{fv_ident = var_ident, fv_info_ptr = new_info_ptr, fv_def_level = NotALevel, fv_count = count } : args], var_heap <:= (var_info_ptr, VI_Empty)) convertDynamicTypes dyn_ptrs update_info = foldSt update_dynamic dyn_ptrs update_info @@ -1214,12 +1214,12 @@ where update_dynamic dyn_ptr (type_code_info, expr_heap, type_pattern_vars, var_heap, error) # (dyn_info, expr_heap) = readPtr dyn_ptr expr_heap = case dyn_info of - EI_TempDynamicType (Yes {dt_global_vars, dt_uni_vars, dt_type}) loc_dynamics _ _ expr_ptr {symb_name} + EI_TempDynamicType (Yes {dt_global_vars, dt_uni_vars, dt_type}) loc_dynamics _ _ expr_ptr {symb_ident} # (expr_info, expr_heap) = readPtr expr_ptr expr_heap -> case expr_info of EI_TypeCodes type_codes # (type_var_heap, var_heap, error) - = bind_type_vars_to_type_codes symb_name dt_global_vars type_codes type_code_info.tci_type_var_heap var_heap error + = bind_type_vars_to_type_codes symb_ident dt_global_vars type_codes type_code_info.tci_type_var_heap var_heap error (uni_vars, (type_var_heap, var_heap)) = newTypeVariables dt_uni_vars (type_var_heap, var_heap) (type_code_expr, (type_code_info,var_heap,error)) = toTypeCodeExpression (add_universal_vars_to_type dt_uni_vars dt_type) ({ type_code_info & tci_type_var_heap = type_var_heap }, var_heap, error) @@ -1231,23 +1231,23 @@ where ({ type_code_info & tci_type_var_heap = type_var_heap }, var_heap, error) expr_heap = expr_heap <:= (dyn_ptr, EI_TypeOfDynamic uni_vars type_code_expr) -> convert_local_dynamics loc_dynamics (type_code_info, expr_heap, type_pattern_vars, var_heap, error) - EI_TempDynamicType No loc_dynamics _ _ expr_ptr {symb_name} + EI_TempDynamicType No loc_dynamics _ _ expr_ptr {symb_ident} # (expr_info, expr_heap) = readPtr expr_ptr expr_heap -> case expr_info of EI_TypeCode type_expr - # (type_expr, (var_heap, error)) = updateFreeVarsOfTCE symb_name type_expr (var_heap, error) + # (type_expr, (var_heap, error)) = updateFreeVarsOfTCE symb_ident type_expr (var_heap, error) expr_heap = expr_heap <:= (dyn_ptr, EI_TypeOfDynamic [] type_expr) -> convert_local_dynamics loc_dynamics (type_code_info, expr_heap, type_pattern_vars, var_heap, error) EI_Selection selectors record_var _ - # (_, var_info_ptr, var_heap, error) = getClassVariable symb_name record_var var_heap error + # (_, var_info_ptr, var_heap, error) = getClassVariable symb_ident record_var var_heap error expr_heap = expr_heap <:= (dyn_ptr, EI_TypeOfDynamic [] (convert_selectors selectors var_info_ptr)) -> convert_local_dynamics loc_dynamics (type_code_info, expr_heap, type_pattern_vars, var_heap, error) - EI_TempDynamicPattern type_vars {dt_global_vars, dt_uni_vars, dt_type} loc_dynamics temp_local_vars _ _ expr_ptr {symb_name} + EI_TempDynamicPattern type_vars {dt_global_vars, dt_uni_vars, dt_type} loc_dynamics temp_local_vars _ _ expr_ptr {symb_ident} # (expr_info, expr_heap) = readPtr expr_ptr expr_heap -> case expr_info of EI_TypeCodes type_codes # (type_var_heap, var_heap, error) - = bind_type_vars_to_type_codes symb_name dt_global_vars type_codes type_code_info.tci_type_var_heap var_heap error + = bind_type_vars_to_type_codes symb_ident dt_global_vars type_codes type_code_info.tci_type_var_heap var_heap error (var_ptrs, (type_pattern_vars, var_heap)) = mapSt addLocalTCInstance temp_local_vars (type_pattern_vars, var_heap) type_var_heap = bind_type_vars_to_type_var_codes type_vars var_ptrs type_var_heap (type_code_expr, (type_code_info,var_heap,error)) = toTypeCodeExpression (add_universal_vars_to_type dt_uni_vars dt_type) ({ type_code_info & tci_type_var_heap = type_var_heap },var_heap, error) @@ -1258,17 +1258,17 @@ where (type_code_expr, (type_code_info,var_heap,error)) = toTypeCodeExpression (add_universal_vars_to_type dt_uni_vars dt_type) ({ type_code_info & tci_type_var_heap = type_var_heap }, var_heap, error) -> convert_local_dynamics loc_dynamics (type_code_info, expr_heap <:= (dyn_ptr, EI_TypeOfDynamicPattern var_ptrs type_code_expr), type_pattern_vars, var_heap, error) where - bind_type_vars_to_type_codes symb_name type_vars type_codes type_var_heap var_heap error - = fold2St (bind_type_var_to_type_code symb_name) type_vars type_codes (type_var_heap, var_heap, error) + bind_type_vars_to_type_codes symb_ident type_vars type_codes type_var_heap var_heap error + = fold2St (bind_type_var_to_type_code symb_ident) type_vars type_codes (type_var_heap, var_heap, error) where - bind_type_var_to_type_code symb_name {tv_name,tv_info_ptr} type_code (type_var_heap, var_heap, error) - # (type_code, (var_heap, error)) = updateFreeVarsOfTCE symb_name type_code (var_heap, error) + bind_type_var_to_type_code symb_ident {tv_ident,tv_info_ptr} type_code (type_var_heap, var_heap, error) + # (type_code, (var_heap, error)) = updateFreeVarsOfTCE symb_ident type_code (var_heap, error) = (type_var_heap <:= (tv_info_ptr, TVI_TypeCode type_code), var_heap, error) bind_type_vars_to_type_var_codes type_vars var_ptrs type_var_heap = fold2St bind_type_var_to_type_var_code type_vars var_ptrs type_var_heap where - bind_type_var_to_type_var_code {tv_name,tv_info_ptr} var_ptr type_var_heap + bind_type_var_to_type_var_code {tv_ident,tv_info_ptr} var_ptr type_var_heap = type_var_heap <:= (tv_info_ptr, TVI_TypeCode (TCE_Var var_ptr)) add_universal_vars_to_type [] at @@ -1293,25 +1293,25 @@ where = (new_var_ptr, (type_var_heap <:= (tv_info_ptr, TVI_TypeCode (TCE_Var new_var_ptr)), var_heap)) updateFreeVarsOfTCE :: !Ident !TypeCodeExpression (!*VarHeap, !*ErrorAdmin) -> (!TypeCodeExpression, !(!*VarHeap, *ErrorAdmin)) -updateFreeVarsOfTCE symb_name (TCE_Constructor type_index type_cons type_args) var_heap_and_error - # (type_args, var_heap_and_error) = mapSt (updateFreeVarsOfTCE symb_name) type_args var_heap_and_error +updateFreeVarsOfTCE symb_ident (TCE_Constructor type_index type_cons type_args) var_heap_and_error + # (type_args, var_heap_and_error) = mapSt (updateFreeVarsOfTCE symb_ident) type_args var_heap_and_error = (TCE_Constructor type_index type_cons type_args, var_heap_and_error) -updateFreeVarsOfTCE symb_name (TCE_Selector selections var_info_ptr) var_heap_and_error - # (var_info_ptr, var_heap_and_error) = getTCDictionary symb_name var_info_ptr var_heap_and_error +updateFreeVarsOfTCE symb_ident (TCE_Selector selections var_info_ptr) var_heap_and_error + # (var_info_ptr, var_heap_and_error) = getTCDictionary symb_ident var_info_ptr var_heap_and_error = (TCE_Selector selections var_info_ptr, var_heap_and_error) -updateFreeVarsOfTCE symb_name (TCE_TypeTerm var_info_ptr) var_heap_and_error - # (var_info_ptr, var_heap_and_error) = getTCDictionary symb_name var_info_ptr var_heap_and_error +updateFreeVarsOfTCE symb_ident (TCE_TypeTerm var_info_ptr) var_heap_and_error + # (var_info_ptr, var_heap_and_error) = getTCDictionary symb_ident var_info_ptr var_heap_and_error = (TCE_TypeTerm var_info_ptr, var_heap_and_error) -updateFreeVarsOfTCE symb_name tce var_heap_and_error +updateFreeVarsOfTCE symb_ident tce var_heap_and_error = (tce, var_heap_and_error) -getTCDictionary symb_name var_info_ptr (var_heap, error) +getTCDictionary symb_ident var_info_ptr (var_heap, error) # (var_info, var_heap) = readPtr var_info_ptr var_heap = case var_info of - VI_ClassVar var_name new_info_ptr count - -> (new_info_ptr, (var_heap <:= (var_info_ptr, VI_ClassVar var_name new_info_ptr (inc count)), error)) + VI_ClassVar var_ident new_info_ptr count + -> (new_info_ptr, (var_heap <:= (var_info_ptr, VI_ClassVar var_ident new_info_ptr (inc count)), error)) _ - -> (var_info_ptr, (var_heap, overloadingError symb_name error)) + -> (var_info_ptr, (var_heap, overloadingError symb_ident error)) :: TypeCodeInfo = { tci_next_index :: !Index @@ -1333,17 +1333,17 @@ toTypeCodeConstructor type=:{glob_object=type_index, glob_module=module_index} c # types = common_defs.[module_index].com_type_defs // sanity check ... - # type_name - = types.[type_index].td_name.id_name + # type_ident + = types.[type_index].td_ident.id_name # tc_type_name - = types.[tc_type_index].td_name.id_name - | "TC;" +++ type_name <> tc_type_name - = fatal "toTypeCodeConstructor" ("name mismatch (" +++ type_name +++ ", " +++ tc_type_name +++ ")") + = types.[tc_type_index].td_ident.id_name + | "TC;" +++ type_ident <> tc_type_name + = fatal "toTypeCodeConstructor" ("name mismatch (" +++ type_ident +++ ", " +++ tc_type_name +++ ")") // ... sanity check # ({td_rhs=AlgType [{ds_ident, ds_index}:_]}) = types.[tc_type_index] # type_constructor - = { symb_name = ds_ident + = { symb_ident = ds_ident , symb_kind = SK_Constructor {glob_module = module_index, glob_object = ds_index} } = GTT_Constructor type_constructor False @@ -1397,14 +1397,14 @@ instance toTypeCodeExpression Type where instance toTypeCodeExpression TypeVar where - toTypeCodeExpression {tv_name,tv_info_ptr} (tci=:{tci_type_var_heap}, var_heap, error) + toTypeCodeExpression {tv_ident,tv_info_ptr} (tci=:{tci_type_var_heap}, var_heap, error) # (type_info, tci_type_var_heap) = readPtr tv_info_ptr tci_type_var_heap tci = { tci & tci_type_var_heap = tci_type_var_heap } = case type_info of TVI_TypeCode type_code -> (type_code, (tci,var_heap,error)) _ - -> abort ("toTypeCodeExpression (TypeVar)" ---> ((ptrToInt tv_info_ptr, tv_name))) + -> abort ("toTypeCodeExpression (TypeVar)" ---> ((ptrToInt tv_info_ptr, tv_ident))) instance toTypeCodeExpression AType where @@ -1432,7 +1432,7 @@ class updateExpression e :: !Index !e !*UpdateInfo -> (!e, !*UpdateInfo) instance updateExpression Expression where - updateExpression group_index (App app=:{app_symb=symb=:{symb_kind,symb_name},app_args,app_info_ptr}) ui + updateExpression group_index (App app=:{app_symb=symb=:{symb_kind,symb_ident},app_args,app_info_ptr}) ui # (app_args, ui) = updateExpression group_index app_args ui | isNilPtr app_info_ptr = (App { app & app_args = app_args }, ui) @@ -1445,10 +1445,10 @@ where | fun_index == NoIndex -> (App { app & app_args = app_args }, ui) # (CheckedType {st_context}, ui) = ui!ui_fun_env.[fun_index] - (app_args, (ui_var_heap, ui_error)) = mapAppendSt (build_context_arg symb_name) st_context app_args (ui.ui_var_heap, ui.ui_error) + (app_args, (ui_var_heap, ui_error)) = mapAppendSt (build_context_arg symb_ident) st_context app_args (ui.ui_var_heap, ui.ui_error) -> (App { app & app_args = app_args }, { ui & ui_var_heap = ui_var_heap, ui_error = ui_error }) EI_Context context_args - # (app_args, ui) = adjustClassExpressions symb_name context_args app_args ui + # (app_args, ui) = adjustClassExpressions symb_ident context_args app_args ui #! main_dcl_module_n = ui.ui_x.UpdateInfoX.x_main_dcl_module_n #! fun_index = get_recursive_fun_index group_index symb_kind main_dcl_module_n ui.ui_fun_defs | fun_index == NoIndex @@ -1457,17 +1457,17 @@ where # (CheckedType {st_context}, ui) = ui!ui_fun_env.[fun_index] nr_of_context_args = length context_args nr_of_lifted_contexts = length st_context - nr_of_context_args - (app_args, (ui_var_heap, ui_error)) = mapAppendSt (build_context_arg symb_name) (take nr_of_lifted_contexts st_context) app_args (ui.ui_var_heap,ui.ui_error) + (app_args, (ui_var_heap, ui_error)) = mapAppendSt (build_context_arg symb_ident) (take nr_of_lifted_contexts st_context) app_args (ui.ui_var_heap,ui.ui_error) -> (App { app & app_args = app_args }, examine_calls context_args {ui & ui_var_heap = ui_var_heap, ui_error = ui_error }) EI_Instance inst_symbol context_args - # (context_args, ui=:{ui_var_heap, ui_error}) = adjustClassExpressions symb_name context_args [] ui + # (context_args, ui=:{ui_var_heap, ui_error}) = adjustClassExpressions symb_ident context_args [] ui -> (build_application inst_symbol context_args app_args app_info_ptr, examine_calls context_args (new_call inst_symbol.glob_module inst_symbol.glob_object.ds_index { ui & ui_var_heap = ui_var_heap, ui_error = ui_error })) EI_Selection selectors record_var context_args - # (all_args, ui=:{ui_var_heap, ui_error}) = adjustClassExpressions symb_name context_args app_args ui - (var_name, var_info_ptr, ui_var_heap, ui_error) = getClassVariable symb_name record_var ui_var_heap ui_error - select_expr = Selection NormalSelector (Var { var_name = var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr }) selectors + # (all_args, ui=:{ui_var_heap, ui_error}) = adjustClassExpressions symb_ident context_args app_args ui + (var_ident, var_info_ptr, ui_var_heap, ui_error) = getClassVariable symb_ident record_var ui_var_heap ui_error + select_expr = Selection NormalSelector (Var { var_ident = var_ident, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr }) selectors | isEmpty all_args -> (select_expr, { ui & ui_var_heap = ui_var_heap, ui_error = ui_error }) -> (select_expr @ all_args, examine_calls context_args @@ -1478,14 +1478,14 @@ where # (var_info, var_heap) = readPtr tc_var var_heap = case var_info of VI_ForwardClassVar var_info_ptr - # (var_name, var_info_ptr, var_heap, error) = getClassVariable symb var_info_ptr var_heap error - -> (Var { var_name = var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr }, (var_heap, error)) - VI_ClassVar var_name new_info_ptr count - -> (Var { var_name = var_name, var_info_ptr = new_info_ptr, var_expr_ptr = nilPtr }, - (var_heap <:= (tc_var, VI_ClassVar var_name new_info_ptr (inc count)), error)) + # (var_ident, var_info_ptr, var_heap, error) = getClassVariable symb var_info_ptr var_heap error + -> (Var { var_ident = var_ident, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr }, (var_heap, error)) + VI_ClassVar var_ident new_info_ptr count + -> (Var { var_ident = var_ident, var_info_ptr = new_info_ptr, var_expr_ptr = nilPtr }, + (var_heap <:= (tc_var, VI_ClassVar var_ident new_info_ptr (inc count)), error)) _ # (new_info_ptr, var_heap) = newPtr VI_Empty var_heap - -> (Var { var_name = symb, var_info_ptr = new_info_ptr, var_expr_ptr = nilPtr }, + -> (Var { var_ident = symb, var_info_ptr = new_info_ptr, var_expr_ptr = nilPtr }, (var_heap <:= (tc_var, VI_ClassVar symb new_info_ptr 1), overloadingError symb error)) get_recursive_fun_index :: !Index !SymbKind Int !{# FunDef} -> Index @@ -1505,7 +1505,7 @@ where = NoIndex build_application def_symbol=:{glob_object} context_args orig_args app_info_ptr - = App {app_symb = { symb_name = glob_object.ds_ident, + = App {app_symb = { symb_ident = glob_object.ds_ident, symb_kind = SK_Function { def_symbol & glob_object = glob_object.ds_index } }, app_args = context_args ++ orig_args, app_info_ptr = app_info_ptr } @@ -1532,7 +1532,7 @@ where examine_calls [expr : exprs] ui = examine_calls exprs (examine_calls_in_expr expr ui) where - examine_calls_in_expr (App {app_symb = {symb_name,symb_kind}, app_args}) ui + examine_calls_in_expr (App {app_symb = {symb_ident,symb_kind}, app_args}) ui = examine_calls app_args (examine_application symb_kind ui) examine_calls_in_expr (Let {let_expr,let_lazy_binds}) ui # ui = examine_calls_in_expr let_expr ui @@ -1650,8 +1650,8 @@ where EI_Instance array_select [] -> (ArraySelection array_select expr_ptr index_expr, ui) EI_Selection selectors record_var context_args - # (var_name, var_info_ptr, ui_var_heap, ui_error) = getClassVariable ds_ident record_var ui.ui_var_heap ui.ui_error - -> (DictionarySelection { var_name = var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr } selectors expr_ptr index_expr, + # (var_ident, var_info_ptr, ui_var_heap, ui_error) = getClassVariable ds_ident record_var ui.ui_var_heap ui.ui_error + -> (DictionarySelection { var_ident = var_ident, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr } selectors expr_ptr index_expr, { ui & ui_var_heap = ui_var_heap, ui_error = ui_error }) updateExpression group_index selection ui = (selection, ui) @@ -1680,25 +1680,25 @@ where updateExpression group_index l ui = mapSt (updateExpression group_index) l ui -adjustClassExpressions symb_name exprs tail_exprs ui - = mapAppendSt (adjustClassExpression symb_name) exprs tail_exprs ui +adjustClassExpressions symb_ident exprs tail_exprs ui + = mapAppendSt (adjustClassExpression symb_ident) exprs tail_exprs ui where - adjustClassExpression symb_name (App app=:{app_args}) ui - # (app_args, ui) = adjustClassExpressions symb_name app_args [] ui + adjustClassExpression symb_ident (App app=:{app_args}) ui + # (app_args, ui) = adjustClassExpressions symb_ident app_args [] ui = (App { app & app_args = app_args }, ui) - adjustClassExpression symb_name (ClassVariable var_info_ptr) ui=:{ui_var_heap, ui_error} - # (var_name, var_info_ptr, ui_var_heap, ui_error) = getClassVariable symb_name var_info_ptr ui_var_heap ui_error - = (Var { var_name = var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr }, { ui & ui_var_heap = ui_var_heap, ui_error = ui_error}) - adjustClassExpression symb_name (Selection opt_type expr selectors) ui - # (expr, ui) = adjustClassExpression symb_name expr ui + adjustClassExpression symb_ident (ClassVariable var_info_ptr) ui=:{ui_var_heap, ui_error} + # (var_ident, var_info_ptr, ui_var_heap, ui_error) = getClassVariable symb_ident var_info_ptr ui_var_heap ui_error + = (Var { var_ident = var_ident, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr }, { ui & ui_var_heap = ui_var_heap, ui_error = ui_error}) + adjustClassExpression symb_ident (Selection opt_type expr selectors) ui + # (expr, ui) = adjustClassExpression symb_ident expr ui = (Selection opt_type expr selectors, ui) - adjustClassExpression symb_name tce=:(TypeCodeExpression type_code) ui + adjustClassExpression symb_ident tce=:(TypeCodeExpression type_code) ui # (type_code, ui) = adjust_type_code type_code ui = (TypeCodeExpression type_code, {ui & ui_has_type_codes = True}) where adjust_type_code (TCE_TypeTerm var_info_ptr) ui=:{ui_var_heap,ui_error} # (var_info_ptr, (ui_var_heap,ui_error)) - = getTCDictionary symb_name var_info_ptr (ui_var_heap, ui_error) + = getTCDictionary symb_ident var_info_ptr (ui_var_heap, ui_error) # ui = { ui & ui_var_heap = ui_var_heap, ui_error = ui_error} = (TCE_TypeTerm var_info_ptr, ui) @@ -1717,20 +1717,20 @@ where adjust_type_code type_code ui = (type_code, ui) - adjustClassExpression symb_name (Let this_let=:{let_strict_binds, let_lazy_binds, let_expr }) ui - # (let_strict_binds, ui) = adjust_let_binds symb_name let_strict_binds ui - (let_lazy_binds, ui) = adjust_let_binds symb_name let_lazy_binds ui - (let_expr, ui) = adjustClassExpression symb_name let_expr ui + adjustClassExpression symb_ident (Let this_let=:{let_strict_binds, let_lazy_binds, let_expr }) ui + # (let_strict_binds, ui) = adjust_let_binds symb_ident let_strict_binds ui + (let_lazy_binds, ui) = adjust_let_binds symb_ident let_lazy_binds ui + (let_expr, ui) = adjustClassExpression symb_ident let_expr ui = (Let { this_let & let_strict_binds = let_strict_binds, let_lazy_binds = let_lazy_binds, let_expr = let_expr }, ui) where - adjust_let_binds symb_name let_binds ui - = mapSt (adjust_let_bind symb_name) let_binds ui + adjust_let_binds symb_ident let_binds ui + = mapSt (adjust_let_bind symb_ident) let_binds ui - adjust_let_bind symb_name let_bind=:{lb_src} ui - # (lb_src, ui) = adjustClassExpression symb_name lb_src ui + adjust_let_bind symb_ident let_bind=:{lb_src} ui + # (lb_src, ui) = adjustClassExpression symb_ident lb_src ui = ({let_bind & lb_src = lb_src}, ui) - adjustClassExpression symb_name expr ui + adjustClassExpression symb_ident expr ui = (expr, ui) let_ptr nr_of_binds ui=:{ui_symbol_heap} diff --git a/frontend/parse.icl b/frontend/parse.icl index 57dfa52..971d2df 100644 --- a/frontend/parse.icl +++ b/frontend/parse.icl @@ -292,7 +292,7 @@ wantModule iclmodule file_id=:{id_name} import_file_position support_generics ha # hash_table=set_hte_mark 0 hash_table ->(ok,mod,hash_table,file,files) (No, files) - -> let mod = { mod_name = file_id, mod_modification_time = "", mod_type = MK_None, mod_imports = [], mod_imported_objects = [], mod_defs = [] } in + -> let mod = { mod_ident = file_id, mod_modification_time = "", mod_type = MK_None, mod_imports = [], mod_imported_objects = [], mod_defs = [] } in (False, mod, hash_table, error <<< "Error " <<< import_file_position <<< ": " <<< file_name <<< " could not be imported\n", files) where file_name = if iclmodule (id_name +++ ".icl") (id_name +++ ".dcl") @@ -300,7 +300,7 @@ where initModule :: String String ScanState !*HashTable !*File *Files -> (!Bool, !ParsedModule, !*HashTable, !*File, !*Files) initModule file_name modification_time scanState hash_table error files - # (succ, mod_type, mod_name, scanState) = try_module_header iclmodule scanState + # (succ, mod_type, mod_ident, scanState) = try_module_header iclmodule scanState | succ # pState = { ps_scanState = scanState , ps_error = { pea_file = error, pea_ok = True } @@ -308,8 +308,8 @@ where , ps_hash_table = hash_table , ps_support_generics = support_generics } - pState = verify_name mod_name id_name file_name pState - (mod_ident, pState) = stringToIdent mod_name IC_Module pState + pState = verify_name mod_ident id_name file_name pState + (mod_ident, pState) = stringToIdent mod_ident IC_Module pState pState = check_layout_rule pState (defs, pState) = want_definitions (SetGlobalContext iclmodule) pState {ps_scanState,ps_hash_table,ps_error} @@ -317,7 +317,7 @@ where defs = if (ParseOnly && id_name <> "StdOverloaded" && id_name <> "StdArray" && id_name <> "StdEnum" && id_name <> "StdBool" && id_name <> "StdDynamics" && id_name <> "StdGeneric") [PD_Import imports \\ PD_Import imports <- defs] defs - mod = { mod_name = mod_ident, mod_modification_time = modification_time, mod_type = mod_type, mod_imports = [], mod_imported_objects = [], mod_defs = defs } + mod = { mod_ident = mod_ident, mod_modification_time = modification_time, mod_type = mod_type, mod_imports = [], mod_imported_objects = [], mod_defs = defs } = ( ps_error.pea_ok , mod, ps_hash_table , ps_error.pea_file @@ -325,7 +325,7 @@ where ) // otherwise // ~ succ # ({fp_line}, scanState) = getPosition scanState - mod = { mod_name = file_id, mod_modification_time = modification_time, mod_type = mod_type, mod_imports = [], mod_imported_objects = [], mod_defs = [] } + mod = { mod_ident = file_id, mod_modification_time = modification_time, mod_type = mod_type, mod_imports = [], mod_imported_objects = [], mod_defs = [] } = (False, mod, hash_table, error <<< "Error [" <<< file_name <<< ',' <<< fp_line <<< "]: incorrect module header", closeScanner scanState files) @@ -497,11 +497,11 @@ where # pState = wantToken FunctionContext "type argument" GenericCloseToken pState | ok -> case type_cons of - (TypeConsSymb {type_name}) - | type_name == type_CONS_ident + (TypeConsSymb {type_ident}) + | type_ident == type_CONS_ident # (cons_CONS_ident, pState) = stringToIdent "GenericConsInfo" IC_Expression pState -> (PE_List [PE_Ident cons_CONS_ident, geninfo_arg], pState) - | type_name == type_FIELD_ident + | type_ident == type_FIELD_ident # (cons_FIELD_ident, pState) = stringToIdent "GenericFieldInfo" IC_Expression pState -> (PE_List [PE_Ident cons_FIELD_ident, geninfo_arg], pState) _ @@ -534,8 +534,8 @@ where # (rhs, _, pState) = wantRhs localsExpected (ruleDefiningRhsSymbol parseContext) pState # generic_case = - { gc_name = ident - , gc_gname = generic_ident + { gc_ident = ident + , gc_gident = generic_ident , gc_generic = {gi_module=NoIndex,gi_index=NoIndex} , gc_arity = length args , gc_pos = pos @@ -1068,8 +1068,8 @@ wantImports pState wantFromImports :: !ParseState -> (!ParsedImport, !ParseState) wantFromImports pState - # (mod_name, pState) = wantModuleName pState - (mod_ident, pState) = stringToIdent mod_name IC_Module pState + # (mod_ident, pState) = wantModuleName pState + (mod_ident, pState) = stringToIdent mod_ident IC_Module pState pState = wantToken GeneralContext "from imports" ImportToken pState (file_name, line_nr, pState) = getFileAndLineNr pState (import_symbols, pState) = wantSequence CommaToken GeneralContext pState @@ -1139,12 +1139,12 @@ want_2_0_import_declaration token pState -> (ID_Class { ii_ident = class_id, ii_extended = ii_extended } (Yes members), pState) -> (ID_Class { ii_ident = class_id, ii_extended = ii_extended } No, tokenBack pState) InstanceToken - # (class_name, pState) = want pState + # (class_ident, pState) = want pState // (ii_extended, pState) = optional_extension pState // MW: removed but still not ok ii_extended = False (types, pState) = wantList "instance types" tryBrackType pState - (class_id, pState) = stringToIdent class_name IC_Class pState - (inst_id, pState) = stringToIdent class_name (IC_Instance types) pState + (class_id, pState) = stringToIdent class_ident IC_Class pState + (inst_id, pState) = stringToIdent class_ident (IC_Instance types) pState (context, pState) = optionalContext pState -> (ID_Instance { ii_ident = class_id, ii_extended = ii_extended } inst_id (types,context), pState) IdentToken fun_name @@ -1221,7 +1221,7 @@ wantClassDefinition parseContext pos pState | begin_members # (class_id, pState) = stringToIdent class_or_member_name IC_Class pState (members, pState) = wantDefinitions (SetClassOrInstanceDefsContext parseContext) pState - class_def = { class_name = class_id, class_arity = class_arity, class_args = class_args, + class_def = { class_ident = class_id, class_arity = class_arity, class_args = class_args, class_context = contexts, class_pos = pos, class_members = {}, class_cons_vars = class_cons_vars, class_dictionary = { ds_ident = { class_id & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex}, class_arg_kinds = [] } @@ -1232,7 +1232,7 @@ wantClassDefinition parseContext pos pState // otherwise # pState = tokenBack pState (class_id, pState) = stringToIdent class_or_member_name IC_Class pState - class_def = { class_name = class_id, class_arity = class_arity, class_args = class_args, + class_def = { class_ident = class_id, class_arity = class_arity, class_args = class_args, class_context = contexts, class_pos = pos, class_members = {}, class_cons_vars = class_cons_vars, class_dictionary = { ds_ident = { class_id & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex }, class_arg_kinds = []} @@ -1268,8 +1268,8 @@ wantClassDefinition parseContext pos pState (token, pState) = nextToken FunctionContext pState (prio, pState) = optionalPriority cIsInfix token pState = (cIsNotAClass, member_name, prio, pState) - # (class_name, pState) = want_name token pState - = (cMightBeAClass, class_name, NoPrio, pState) + # (class_ident, pState) = want_name token pState + = (cMightBeAClass, class_ident, NoPrio, pState) where want_name (IdentToken name) pState = (name, pState) @@ -1281,7 +1281,7 @@ wantClassDefinition parseContext pos pState (member_id, pState) = stringToIdent member_name IC_Expression pState (class_id, pState) = stringToIdent member_name IC_Class pState member = PD_TypeSpec pos member_id prio (Yes tspec) SP_None - class_def = { class_name = class_id, class_arity = class_arity, class_args = class_args, + class_def = { class_ident = class_id, class_arity = class_arity, class_args = class_args, class_context = contexts, class_pos = pos, class_members = {}, class_cons_vars = class_cons_vars, class_dictionary = { ds_ident = { class_id & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex }, class_arg_kinds = []} @@ -1306,10 +1306,10 @@ wantClassDefinition parseContext pos pState wantInstanceDeclaration :: !ParseContext !Position !ParseState -> (!ParsedDefinition, !ParseState) wantInstanceDeclaration parseContext pi_pos pState - # (class_name, pState) = want pState - (pi_class, pState) = stringToIdent class_name IC_Class pState + # (class_ident, pState) = want pState + (pi_class, pState) = stringToIdent class_ident IC_Class pState ((pi_types, pi_context), pState) = want_instance_type pState - (pi_ident, pState) = stringToIdent class_name (IC_Instance pi_types) pState + (pi_ident, pState) = stringToIdent class_ident (IC_Instance pi_types) pState // AA.. # (token, pState) = nextToken TypeContext pState /* @@ -1329,7 +1329,7 @@ wantInstanceDeclaration parseContext pi_pos pState // otherwise // ~ (isIclContext parseContext) | token == CommaToken # (pi_types_and_contexts, pState) = want_instance_types pState - (idents, pState) = seqList [stringToIdent class_name (IC_Instance type) \\ (type,context) <- pi_types_and_contexts] pState + (idents, pState) = seqList [stringToIdent class_ident (IC_Instance type) \\ (type,context) <- pi_types_and_contexts] pState = (PD_Instances // [ { pi_class = pi_class, pi_ident = pi_ident, pi_types = type, pi_context = context // voor martin [ { pi_class = pi_class, pi_ident = ident, pi_types = type, pi_context = context @@ -1401,9 +1401,9 @@ where where build_contexts [] types arity pState = ([], pState) - build_contexts [class_name : class_names] types arity pState + build_contexts [class_ident : class_names] types arity pState # (contexts, pState) = build_contexts class_names types arity pState - (class_ident, pState) = stringToIdent class_name IC_Class pState + (class_ident, pState) = stringToIdent class_ident IC_Class pState tc_class = { glob_object = MakeDefinedSymbol class_ident NoIndex (length types), glob_module = NoIndex } = ([{ tc_class = tc_class, tc_types = types, tc_var = nilPtr } : contexts], pState) */ @@ -1476,13 +1476,13 @@ optionalCoercions pState # (more_inequals, pState) = want_inequalities pState = (inequals ++ more_inequals, pState) = (inequals, tokenBack pState) - want_attr_inequality (IdentToken var_name) pState - | isLowerCaseName var_name - # (off_ident, pState) = stringToIdent var_name IC_TypeAttr pState + want_attr_inequality (IdentToken var_ident) pState + | isLowerCaseName var_ident + # (off_ident, pState) = stringToIdent var_ident IC_TypeAttr pState (token, pState) = nextToken TypeContext pState | token == LessThanOrEqualToken - # (var_name, pState) = wantLowerCaseName "attribute inequality" pState - (dem_ident, pState) = stringToIdent var_name IC_TypeAttr pState + # (var_ident, pState) = wantLowerCaseName "attribute inequality" pState + (dem_ident, pState) = stringToIdent var_ident IC_TypeAttr pState ai_demanded = makeAttributeVar dem_ident = (ai_demanded, [{ ai_demanded = ai_demanded, ai_offered = makeAttributeVar off_ident }], pState) # (ai_demanded, inequals, pState) = want_attr_inequality token pState @@ -1516,8 +1516,8 @@ wantGenericDefinition parseContext pos pState # (type, pState) = want_type pState // SymbolType # pState = wantEndOfDefinition "generic definition" pState # gen_def = - { gen_name = ident - , gen_member_name = member_ident + { gen_ident = ident + , gen_member_ident = member_ident , gen_type = type , gen_vars = arg_vars , gen_pos = pos @@ -1570,8 +1570,8 @@ where # (generic_ident, pState) = stringToIdent name IC_Generic pState # (type_cons, pState) = get_type_cons type pState # derive_def = - { gc_name = ident - , gc_gname = generic_ident + { gc_ident = ident + , gc_gident = generic_ident , gc_generic = {gi_module=NoIndex,gi_index=NoIndex} , gc_arity = 0 , gc_pos = pos @@ -1650,8 +1650,8 @@ where = (MakeTypeDef ident args (ConsList []) attr contexts pos, annot, pState) want_type_rhs :: !ParseContext !ParsedTypeDef !Token !Annotation !ParseState -> (ParsedDefinition, !ParseState) - want_type_rhs parseContext td=:{td_name,td_attribute} EqualToken annot pState - # name = td_name.id_name + want_type_rhs parseContext td=:{td_ident,td_attribute} EqualToken annot pState + # name = td_ident.id_name pState = verify_annot_attr annot td_attribute name pState (exi_vars, pState) = optionalExistentialQuantifiedVariables pState (token, pState) = nextToken GeneralContext pState // should be TypeContext @@ -1677,13 +1677,13 @@ where -> (PD_Type td, parseError "Algebraic type" No ("No lhs strictness annotation for the algebraic type "+name) pState) where want_record_type_rhs name is_boxed_record exi_vars pState - # (fields, pState) = wantFields td_name pState + # (fields, pState) = wantFields td_ident pState pState = wantToken TypeContext "record type def" CurlyCloseToken pState (rec_cons_ident, pState) = stringToIdent ("_" + name) IC_Expression pState = (PD_Type { td & td_rhs = SelectorList rec_cons_ident exi_vars is_boxed_record fields }, pState) want_type_rhs parseContext td=:{td_attribute} ColonDefinesToken annot pState // type Macro - # name = td.td_name.id_name + # name = td.td_ident.id_name pState = verify_annot_attr annot td_attribute name pState (atype, pState) = want pState // Atype td = {td & td_rhs = TypeSpec atype} @@ -1694,7 +1694,7 @@ where want_type_rhs parseContext td=:{td_attribute} token=:DefinesColonToken annot pState | isIclContext parseContext = (PD_Erroneous, parseError "type RHS" (Yes token) "type definition" pState) - # name = td.td_name.id_name + # name = td.td_ident.id_name (atype, pState) = want pState // Atype # (td_attribute, properties) = determine_properties annot td_attribute td = {td & td_rhs = AbstractTypeSpec properties atype, td_attribute=td_attribute} @@ -1711,7 +1711,7 @@ where # (td_attribute, properties) = determine_properties annot td_attribute # td = { td & td_attribute = td_attribute, td_rhs = EmptyRhs properties} = (PD_Type td, tokenBack pState) - # name = td.td_name.id_name + # name = td.td_ident.id_name = (PD_Type { td & td_rhs = EmptyRhs cAllBitsClear}, parseError "abstract type" No ("type attribute "+toString td_attribute+" for abstract type "+name+" is not") (tokenBack pState)) verify_annot_attr :: !Annotation !TypeAttribute !String !ParseState -> ParseState @@ -1735,9 +1735,9 @@ where want_constructor_list :: ![ATypeVar] !Token !ParseState -> (.[ParsedConstructor],ParseState) want_constructor_list exi_vars token pState # token = basic_type_to_constructor token - # (pc_cons_name, pc_cons_prio, pc_cons_pos, pState) = want_cons_name_and_prio token pState + # (pc_cons_ident, pc_cons_prio, pc_cons_pos, pState) = want_cons_name_and_prio token pState (pc_arg_types, pState) = parseList tryBrackSAType pState - cons = { pc_cons_name = pc_cons_name, pc_arg_types = atypes_from_satypes pc_arg_types, pc_args_strictness=strictness_from_satypes pc_arg_types, pc_cons_arity = length pc_arg_types, + cons = { pc_cons_ident = pc_cons_ident, pc_arg_types = atypes_from_satypes pc_arg_types, pc_args_strictness=strictness_from_satypes pc_arg_types, pc_cons_arity = length pc_arg_types, pc_cons_prio = pc_cons_prio, pc_exi_vars = exi_vars, pc_cons_pos = pc_cons_pos} (token, pState) = nextToken TypeContext pState | token == BarToken @@ -1784,7 +1784,7 @@ where basic_type_to_constructor DynamicTypeToken = IdentToken "Dynamic" basic_type_to_constructor token = token -makeAttributeVar name :== { av_name = name, av_info_ptr = nilPtr } +makeAttributeVar name :== { av_ident = name, av_info_ptr = nilPtr } optionalAnnot :: !ParseState -> (!Bool,!Annotation, !ParseState) optionalAnnot pState @@ -1889,13 +1889,13 @@ wantFields record_type pState want_field record_type pState # (field_name, pState) = wantLowerCaseName "record field" pState (fname, linenr, pState) = getFileAndLineNr pState - (ps_field_name, pState) = stringToIdent field_name (IC_Field record_type) pState - (ps_selector_name, pState) = stringToIdent field_name IC_Selector pState + (ps_field_ident, pState) = stringToIdent field_name (IC_Field record_type) pState + (ps_selector_ident, pState) = stringToIdent field_name IC_Selector pState (ps_field_var, pState) = stringToIdent field_name IC_Expression pState pState = wantToken TypeContext "record field" DoubleColonToken pState // (ps_field_type, pState) = want pState // wantAType (annotation,ps_field_type, pState) = wantAnnotatedAType pState - = ({ ps_field_name = ps_field_name, ps_selector_name = ps_selector_name, ps_field_type = ps_field_type, + = ({ ps_field_ident = ps_field_ident, ps_selector_ident = ps_selector_ident, ps_field_type = ps_field_type, ps_field_annotation = annotation, ps_field_var = ps_field_var, ps_field_pos = LinePos fname linenr}, pState) @@ -2023,10 +2023,10 @@ where // Sjaak 210801 ... adjustAttribute :: !TypeAttribute Type *ParseState -> (!TypeAttribute, !*ParseState) -adjustAttribute attr (TV {tv_name}) pState - = adjustAttributeOfTypeVariable attr tv_name pState -adjustAttribute attr (GTV {tv_name}) pState - = adjustAttributeOfTypeVariable attr tv_name pState +adjustAttribute attr (TV {tv_ident}) pState + = adjustAttributeOfTypeVariable attr tv_ident pState +adjustAttribute attr (GTV {tv_ident}) pState + = adjustAttributeOfTypeVariable attr tv_ident pState adjustAttribute attr type pState = (attr, pState) @@ -2230,8 +2230,8 @@ convertAAType [atype:atypes] attr pState # (attr, pState) = determAttr_ attr atype.at_attribute type pState with determAttr_ :: !TypeAttribute !TypeAttribute !Type !ParseState -> (!TypeAttribute, !ParseState) - determAttr_ TA_None (TA_Var {av_name}) (TV {tv_name}) pState - | av_name.id_name==tv_name.id_name + determAttr_ TA_None (TA_Var {av_ident}) (TV {tv_ident}) pState + | av_ident.id_name==tv_ident.id_name = (TA_Anonymous,pState) determAttr_ attr1 attr2 type pState = determAttr attr1 attr2 type pState @@ -2496,7 +2496,7 @@ tryQuantifiedTypeVar pState (succ, attr, pState) = try_attribute token pState | succ # (typevar, pState) = wantTypeVar pState - (attr, pState) = adjustAttributeOfTypeVariable attr typevar.tv_name pState + (attr, pState) = adjustAttributeOfTypeVariable attr typevar.tv_ident pState = (True, {atv_attribute = attr, atv_variable = typevar}, pState) # (succ, typevar, pState) = tryTypeVarT token pState | succ diff --git a/frontend/partition.icl b/frontend/partition.icl index 46a0288..8c42f11 100644 --- a/frontend/partition.icl +++ b/frontend/partition.icl @@ -52,7 +52,7 @@ where = visit_functions funs (min min_dep mark) max_fun_nr fun_defs pi visit_functions [MacroCall module_index fc_index _:funs] min_dep max_fun_nr fun_defs pi - = abort ("visit_functions "+++toString fd.fun_symb+++" "+++toString module_index+++" "+++toString fc_index) + = abort ("visit_functions "+++toString fd.fun_ident+++" "+++toString module_index+++" "+++toString fc_index) visit_functions [DclFunCall module_index fc_index:funs] min_dep max_fun_nr fun_defs pi = visit_functions funs min_dep max_fun_nr fun_defs pi @@ -188,7 +188,7 @@ where = visit_functions funs (min min_dep mark) max_fun_nr fun_defs pi visit_functions [MacroCall module_index fc_index _:funs] min_dep max_fun_nr fun_defs pi - = abort ("visit_functions "+++toString fd.fun_symb+++" "+++toString module_index+++" "+++toString fc_index) + = abort ("visit_functions "+++toString fd.fun_ident+++" "+++toString module_index+++" "+++toString fc_index) visit_functions [DclFunCall module_index fc_index:funs] min_dep max_fun_nr fun_defs pi = visit_functions funs min_dep max_fun_nr fun_defs pi @@ -322,7 +322,7 @@ where = visit_functions funs (min min_dep mark) max_fun_nr fun_defs fun_heap pi visit_functions [MacroCall module_index fc_index _:funs] min_dep max_fun_nr fun_defs fun_heap pi - = abort ("visit_functions "+++toString fd.fun_symb+++" "+++toString module_index+++" "+++toString fc_index) + = abort ("visit_functions "+++toString fd.fun_ident+++" "+++toString module_index+++" "+++toString fc_index) visit_functions [DclFunCall module_index fc_index:funs] min_dep max_fun_nr fun_defs fun_heap pi = visit_functions funs min_dep max_fun_nr fun_defs fun_heap pi @@ -580,7 +580,7 @@ import StdDebug ref_null fd=:{fun_body=TransformedBody {tb_args,tb_rhs}} pi_collect // | not (fst (ferror (stderr <<< fd))) -// # tb_args = tb_args ---> ("ref_null",fd.fun_symb,tb_args,tb_rhs) +// # tb_args = tb_args ---> ("ref_null",fd.fun_ident,tb_args,tb_rhs) # (new_rhs, new_args, _, _, pi_collect) = determineVariablesAndRefCounts tb_args tb_rhs pi_collect # fd = {fd & fun_body=TransformedBody {tb_args=new_args,tb_rhs=new_rhs}} = (fd,pi_collect) diff --git a/frontend/postparse.icl b/frontend/postparse.icl index 9bfba72..deb4e0a 100644 --- a/frontend/postparse.icl +++ b/frontend/postparse.icl @@ -109,7 +109,7 @@ addFunctionsRange fun_defs ca } MakeNewImpOrDefFunction name arity body kind prio opt_type pos - :== { fun_symb = name, fun_arity = arity, fun_priority = prio, fun_type = opt_type, fun_kind = kind, + :== { fun_ident = name, fun_arity = arity, fun_priority = prio, fun_type = opt_type, fun_kind = kind, fun_body = ParsedBody body, fun_pos = pos, fun_lifted = 0, fun_info = EmptyFunInfo } class collectFunctions a :: a Bool !*CollectAdmin -> (a, !*CollectAdmin) @@ -127,9 +127,9 @@ where # (range, ca) = addFunctionsRange [transformLambda lam_ident args res pos] ca = (PE_Let cIsStrict (CollectedLocalDefs { loc_functions = range, loc_nodes = [], loc_in_icl_module=icl_module }) (PE_Ident lam_ident), ca) - collectFunctions (PE_Record rec_expr type_name fields) icl_module ca + collectFunctions (PE_Record rec_expr type_ident fields) icl_module ca # ((rec_expr,fields), ca) = collectFunctions (rec_expr,fields) icl_module ca - = (PE_Record rec_expr type_name fields, ca) + = (PE_Record rec_expr type_ident fields, ca) collectFunctions (PE_Tuple exprs) icl_module ca # (exprs, ca) = collectFunctions exprs icl_module ca = (PE_Tuple exprs, ca) @@ -1045,12 +1045,12 @@ where try_to_find mod_id [] = (False,MK_None) try_to_find mod_id [pmod : pmods] - | mod_id == pmod.mod_name + | mod_id == pmod.mod_ident = (True,pmod.mod_type) = try_to_find mod_id pmods MakeEmptyModule name mod_type - :== { mod_name = name, mod_modification_time = "", mod_type = mod_type, mod_imports = [], mod_imported_objects = [], mod_defs = + :== { mod_ident = name, mod_modification_time = "", mod_type = mod_type, mod_imports = [], mod_imported_objects = [], mod_defs = { def_types = [], def_constructors = [], def_selectors = [], def_classes = [], def_macro_indices={ir_from=0,ir_to=0}, def_macros=[],def_members = [], def_funtypes = [], def_instances = [], def_generics = [], def_generic_cases = []} } @@ -1063,7 +1063,7 @@ parseAndScanDclModule dcl_module import_file_position parsed_modules cached_modu # ca = {ca & ca_hash_table=ca_hash_table, ca_error={pea_file=err_file,pea_ok=True} } | parse_ok = scan_dcl_module mod parsed_modules searchPaths modtimefunction files ca - = (False, [MakeEmptyModule mod.mod_name MK_None: parsed_modules],files, ca) + = (False, [MakeEmptyModule mod.mod_ident MK_None: parsed_modules],files, ca) where scan_dcl_module :: ParsedModule [ScannedModule] !SearchPaths (ModTimeFunction *Files) *Files *CollectAdmin -> (Bool, [ScannedModule],*Files, *CollectAdmin) scan_dcl_module mod=:{mod_defs = pdefs} parsed_modules searchPaths modtimefunction files ca @@ -1082,7 +1082,7 @@ where scanModule :: !ParsedModule ![Ident] !Bool !Bool !*HashTable !*File !SearchPaths (ModTimeFunction *Files) !*Files -> (!Bool, !ScannedModule, !IndexRange, ![FunDef], !Optional ScannedModule, ![ScannedModule],!Int,!Int,!*HashTable, !*File, !*Files) -scanModule mod=:{mod_name,mod_type,mod_defs = pdefs} cached_modules support_generics support_dynamics hash_table err_file searchPaths /*predefs*/ modtimefunction files +scanModule mod=:{mod_ident,mod_type,mod_defs = pdefs} cached_modules support_generics support_dynamics hash_table err_file searchPaths /*predefs*/ modtimefunction files # predefIdents = predefined_idents # ca = { ca_error = {pea_file = err_file, pea_ok = True} , ca_fun_count = 0 @@ -1094,7 +1094,7 @@ scanModule mod=:{mod_name,mod_type,mod_defs = pdefs} cached_modules support_gene (reorganise_icl_ok, ca) = ca!ca_error.pea_ok (import_dcl_ok, optional_parsed_dcl_mod,dcl_module_n,parsed_modules, cached_modules,files, ca) - = scan_main_dcl_module mod_name mod_type modtimefunction files ca + = scan_main_dcl_module mod_ident mod_type modtimefunction files ca (import_dcls_ok, parsed_modules, files, ca) = scanModules imports parsed_modules cached_modules searchPaths support_generics support_dynamics modtimefunction files ca @@ -1135,30 +1135,30 @@ scanModule mod=:{mod_name,mod_type,mod_defs = pdefs} cached_modules support_gene = (reorganise_icl_ok && pea_ok && import_dcl_ok && import_dcls_ok, mod, fun_range, fun_defs, optional_dcl_mod, modules, dcl_module_n,n_functions_and_macros_in_dcl_modules,hash_table, err_file, files) where scan_main_dcl_module :: Ident ModuleKind (ModTimeFunction *Files) *Files *CollectAdmin -> (!Bool,!Optional (Module (CollectedDefinitions (ParsedInstance FunDef) [FunDef])),!Int,![ScannedModule],![Ident],!*Files,!*CollectAdmin) - scan_main_dcl_module mod_name MK_Main _ files ca - = (True, No,NoIndex,[MakeEmptyModule mod_name MK_NoMainDcl], cached_modules,files, ca) - scan_main_dcl_module mod_name MK_None _ files ca + scan_main_dcl_module mod_ident MK_Main _ files ca + = (True, No,NoIndex,[MakeEmptyModule mod_ident MK_NoMainDcl], cached_modules,files, ca) + scan_main_dcl_module mod_ident MK_None _ files ca = (True, No,NoIndex,[], cached_modules,files, ca) - scan_main_dcl_module mod_name kind modtimefunction files ca + scan_main_dcl_module mod_ident kind modtimefunction files ca # module_n_in_cache = in_cache 0 cached_modules; with in_cache module_n [] = NoIndex in_cache module_n [cached_module_ident : pmods] - | mod_name==cached_module_ident + | mod_ident==cached_module_ident = module_n = in_cache (module_n+1) pmods | module_n_in_cache<>NoIndex = (True,No,module_n_in_cache,[],cached_modules,files,ca) # {ca_error, ca_hash_table} = ca - # (parse_ok, mod, hash_table, err_file, /*predefs,*/ files) = wantModule cWantDclFile mod_name NoPos support_generics ca_hash_table ca_error.pea_file searchPaths modtimefunction files + # (parse_ok, mod, hash_table, err_file, /*predefs,*/ files) = wantModule cWantDclFile mod_ident NoPos support_generics ca_hash_table ca_error.pea_file searchPaths modtimefunction files # ca = {ca & ca_hash_table=hash_table, ca_error={pea_file=err_file,pea_ok=True}} | not parse_ok = (False, No,NoIndex, [],cached_modules, files, ca) # pdefs = mod.mod_defs # (_, defs, imports, imported_objects, ca) = reorganiseDefinitionsAndAddTypes support_dynamics False pdefs ca # mod = { mod & mod_imports = imports, mod_imported_objects = imported_objects, mod_defs = defs} - # cached_modules = [mod.mod_name:cached_modules] + # cached_modules = [mod.mod_ident:cached_modules] # (import_ok, parsed_modules,files, ca) = scanModules imports [] cached_modules searchPaths support_generics support_dynamics modtimefunction files ca = (import_ok, Yes mod, NoIndex,parsed_modules, cached_modules,files, ca) @@ -1172,7 +1172,7 @@ where = (pea_ok,Yes mod,ca) collect_main_dcl_module No dcl_module_n ca | dcl_module_n==NoIndex - = (True,Yes (MakeEmptyModule mod_name MK_None),ca) + = (True,Yes (MakeEmptyModule mod_ident MK_None),ca) = (True,No,ca) MakeNewParsedDef ident args rhs pos @@ -1207,7 +1207,7 @@ collectFunctionBodies fun_name fun_arity fun_prio fun_kind defs ca collectGenericBodies :: !GenericCaseDef ![ParsedDefinition] !*CollectAdmin -> (![ParsedBody], ![ParsedDefinition], !*CollectAdmin) collectGenericBodies first_case all_defs=:[PD_GenericCase gc : defs] ca - | first_case.gc_name == gc.gc_name && first_case.gc_type_cons == gc.gc_type_cons + | first_case.gc_ident == gc.gc_ident && first_case.gc_type_cons == gc.gc_type_cons #! (bodies, rest_defs, ca) = collectGenericBodies first_case defs ca # (GCB_ParsedBody args rhs) = gc.gc_body #! body = @@ -1292,18 +1292,18 @@ reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = ConsList cons_defs = (fun_defs, c_defs, imports, imported_objects, ca) where determine_symbols_of_conses :: [ParsedConstructor] Index -> ([DefinedSymbol], Index) - determine_symbols_of_conses [{pc_cons_name,pc_cons_arity} : conses] next_cons_index - # cons = { ds_ident = pc_cons_name, ds_arity = pc_cons_arity, ds_index = next_cons_index } + determine_symbols_of_conses [{pc_cons_ident,pc_cons_arity} : conses] next_cons_index + # cons = { ds_ident = pc_cons_ident, ds_arity = pc_cons_arity, ds_index = next_cons_index } (conses, next_cons_index) = determine_symbols_of_conses conses (inc next_cons_index) = ([cons : conses], next_cons_index) determine_symbols_of_conses [] next_cons_index = ([], next_cons_index) -reorganiseDefinitions icl_module [PD_Type type_def=:{td_name, td_rhs = SelectorList rec_cons_id exivars is_boxed_record sel_defs, td_pos } : defs] cons_count sel_count mem_count type_count ca +reorganiseDefinitions icl_module [PD_Type type_def=:{td_ident, td_rhs = SelectorList rec_cons_id exivars is_boxed_record sel_defs, td_pos } : defs] cons_count sel_count mem_count type_count ca # (sel_syms, new_count) = determine_symbols_of_selectors sel_defs sel_count (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs (inc cons_count) new_count mem_count (type_count+1) ca cons_arity = new_count - sel_count pc_arg_types = [ ps_field_type \\ {ps_field_type} <- sel_defs ] - cons_def = { pc_cons_name = rec_cons_id, pc_cons_prio = NoPrio, pc_cons_arity = cons_arity, pc_cons_pos = td_pos, + cons_def = { pc_cons_ident = rec_cons_id, pc_cons_prio = NoPrio, pc_cons_arity = cons_arity, pc_cons_pos = td_pos, pc_arg_types = pc_arg_types, pc_args_strictness=strictness_from_fields sel_defs,pc_exi_vars = exivars } type_def = { type_def & td_rhs = RecordType {rt_constructor = { ds_ident = rec_cons_id, ds_arity = cons_arity, ds_index = cons_count }, rt_fields = { sel \\ sel <- sel_syms }, rt_is_boxed_record = is_boxed_record}} @@ -1312,8 +1312,8 @@ reorganiseDefinitions icl_module [PD_Type type_def=:{td_name, td_rhs = SelectorL = (fun_defs, c_defs, imports, imported_objects, ca) where determine_symbols_of_selectors :: [ParsedSelector] Index -> ([FieldSymbol], Index) - determine_symbols_of_selectors [{ps_field_name,ps_field_var} : sels] next_selector_index - # field = { fs_name = ps_field_name, fs_var = ps_field_var, fs_index = next_selector_index } + determine_symbols_of_selectors [{ps_field_ident,ps_field_var} : sels] next_selector_index + # field = { fs_ident = ps_field_ident, fs_var = ps_field_var, fs_index = next_selector_index } (fields, next_selector_index) = determine_symbols_of_selectors sels (inc next_selector_index) = ([field : fields], next_selector_index) determine_symbols_of_selectors [] next_selector_index @@ -1333,8 +1333,8 @@ reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = AbstractTypeSpec p type_def = { type_def & td_rhs = AbstractSynType properties type } c_defs = { c_defs & def_types = [type_def : c_defs.def_types] } = (fun_defs, c_defs, imports, imported_objects, ca) -reorganiseDefinitions icl_module [PD_Class class_def=:{class_name,class_arity,class_args} members : defs] cons_count sel_count mem_count type_count ca - # type_context = { tc_class = TCClass {glob_module = NoIndex, glob_object = {ds_ident = class_name, ds_arity = class_arity, ds_index = NoIndex }}, +reorganiseDefinitions icl_module [PD_Class class_def=:{class_ident,class_arity,class_args} members : defs] cons_count sel_count mem_count type_count ca + # type_context = { tc_class = TCClass {glob_module = NoIndex, glob_object = {ds_ident = class_ident, ds_arity = class_arity, ds_index = NoIndex }}, tc_types = [ TV tv \\ tv <- class_args ], tc_var = nilPtr} (mem_defs, mem_macros, ca) = check_symbols_of_class_members members type_context ca (mem_symbs, mem_defs, class_size) = reorganise_member_defs mem_defs mem_count @@ -1348,7 +1348,7 @@ where check_symbols_of_class_members [PD_TypeSpec pos name prio opt_type=:(Yes type=:{st_context,st_arity}) specials : defs] type_context ca # (bodies, fun_kind, defs, ca) = collectFunctionBodies name st_arity prio FK_Unknown defs ca | isEmpty bodies - # mem_def = { me_symb = name, me_type = { type & st_context = [type_context : st_context ]}, me_pos = pos, me_priority = prio, + # mem_def = { me_ident = name, me_type = { type & st_context = [type_context : st_context ]}, me_pos = pos, me_priority = prio, me_offset = NoIndex, me_class_vars = [], me_class = { glob_module = NoIndex, glob_object = NoIndex}, me_type_ptr = nilPtr } ( mem_defs, mem_macros, ca) = check_symbols_of_class_members defs type_context ca = ([mem_def : mem_defs], mem_macros, ca) @@ -1385,9 +1385,9 @@ where = determine_indexes_of_class_members mem_defs first_mem_index 0 determine_indexes_of_class_members :: [MemberDef] Index Index -> ([DefinedSymbol], [MemberDef], Index) - determine_indexes_of_class_members [member=:{me_symb,me_type}:members] first_mem_index mem_offset + determine_indexes_of_class_members [member=:{me_ident,me_type}:members] first_mem_index mem_offset #! (member_symbols, member_defs, last_mem_offset) = determine_indexes_of_class_members members first_mem_index (inc mem_offset) - = ([{ds_ident = me_symb, ds_index = first_mem_index + mem_offset, ds_arity = me_type.st_arity } : member_symbols], + = ([{ds_ident = me_ident, ds_index = first_mem_index + mem_offset, ds_arity = me_type.st_arity } : member_symbols], [ { member & me_offset = mem_offset } : member_defs], last_mem_offset) determine_indexes_of_class_members [] first_mem_index last_mem_offset = ([], [], last_mem_offset) @@ -1439,7 +1439,7 @@ reorganiseDefinitions icl_module [PD_GenericCase gc : defs] cons_count sel_count , pb_position = gc.gc_pos } #! bodies = [body : bodies ] - #! fun_name = genericIdentToFunIdent gc.gc_name gc.gc_type_cons + #! fun_name = genericIdentToFunIdent gc.gc_ident gc.gc_type_cons #! fun = MakeNewImpOrDefFunction fun_name gc.gc_arity bodies (FK_Function cNameNotLocationDependent) NoPrio No gc.gc_pos #! inst = { gc & gc_body = GCB_FunDef fun } #! c_defs = {c_defs & def_generic_cases = [inst : c_defs.def_generic_cases]} @@ -1480,37 +1480,37 @@ reorganiseDefinitionsAndAddTypes support_dynamics icl_module defs ca addTypeConstructors [def : defs] rev_defs ca = addTypeConstructors defs [def : rev_defs] ca -addTypeConstructor def=:{td_name, td_attribute, td_attrs, td_args, td_arity, td_pos} ca=:{ca_hash_table} - # tc_name = "TC;" +++ td_name.id_name +addTypeConstructor def=:{td_ident, td_attribute, td_attrs, td_args, td_arity, td_pos} ca=:{ca_hash_table} + # tc_name = "TC;" +++ td_ident.id_name # ({boxed_ident=tc_cons_ident}, ca_hash_table) = putIdentInHashTable tc_name IC_Expression ca_hash_table # ({boxed_ident=tc_type_ident}, ca_hash_table) = putIdentInHashTable tc_name IC_Type ca_hash_table - = (def, type_tc_def tc_type_ident tc_cons_ident td_name td_attribute td_attrs td_args + = (def, type_tc_def tc_type_ident tc_cons_ident td_ident td_attribute td_attrs td_args td_arity td_pos, { ca & ca_hash_table = ca_hash_table }) where - type_tc_def type_ident cons_ident type_name attr attrs args arity position - = { td_name = type_ident + type_tc_def ident cons_ident type_ident attr attrs args arity position + = { td_ident = ident , td_index = NoIndex , td_arity = arity , td_args = args , td_attrs = attrs , td_context = [] - , td_rhs = ConsList [type_tc_cons cons_ident type_name args arity position] + , td_rhs = ConsList [type_tc_cons cons_ident type_ident args arity position] , td_attribute = attr , td_pos = position , td_used_types = [] } - type_tc_cons cons_ident type_name args arity position - = { pc_cons_name = cons_ident + type_tc_cons cons_ident type_ident args arity position + = { pc_cons_ident = cons_ident , pc_cons_arity = 1 , pc_exi_vars = [] - , pc_arg_types = [type type_name args arity] + , pc_arg_types = [type type_ident args arity] , pc_args_strictness = NotStrict , pc_cons_prio = NoPrio , pc_cons_pos = position } - type type_name args arity + type type_ident args arity = { at_attribute = TA_None - , at_type = TA (MakeNewTypeSymbIdent type_name arity) + , at_type = TA (MakeNewTypeSymbIdent type_ident arity) [{at_attribute = TA_None, at_type = TV arg.atv_variable} \\ arg <- args] } diff --git a/frontend/predef.icl b/frontend/predef.icl index 7dc659a..1354f25 100644 --- a/frontend/predef.icl +++ b/frontend/predef.icl @@ -229,8 +229,8 @@ predefined_idents build_variables var_number max_arity idents | var_number == max_arity = idents - # var_name = "a" +++ toString var_number - # idents = {idents & [PD_TypeVar_a0 + var_number] = i var_name} + # var_ident = "a" +++ toString var_number + # idents = {idents & [PD_TypeVar_a0 + var_number] = i var_ident} = build_variables (inc var_number) max_arity idents init_identifiers :: !*SymbolTable !*World -> (!*SymbolTable,!*World) @@ -467,13 +467,13 @@ make_list_definition list_type_pre_def_symbol_index cons_pre_def_symbol_index ni nil_ident = predefined_idents.[nil_pre_def_symbol_index] list_ident = predefined_idents.[list_type_pre_def_symbol_index] - cons_symb = { ds_ident = cons_ident, ds_arity = 2, ds_index = cons_pre_def_symbol_index-FirstConstructorPredefinedSymbolIndex } + cons_ds = { ds_ident = cons_ident, ds_arity = 2, ds_index = cons_pre_def_symbol_index-FirstConstructorPredefinedSymbolIndex } nil_symb = { ds_ident = nil_ident, ds_arity=0 ,ds_index = nil_pre_def_symbol_index-FirstConstructorPredefinedSymbolIndex } - (list_def, pre_def_symbols) = make_type_def list_type_pre_def_symbol_index [type_var] (AlgType [cons_symb,nil_symb]) pre_def_symbols + (list_def, pre_def_symbols) = make_type_def list_type_pre_def_symbol_index [type_var] (AlgType [cons_ds,nil_symb]) pre_def_symbols list_type = MakeAttributedType (TA (MakeNewTypeSymbIdent list_ident 1) [type_var_with_attr]) - cons_def = { pc_cons_name = cons_ident, pc_cons_arity = 2, pc_arg_types = [type_var_with_attr, list_type], + cons_def = { pc_cons_ident = cons_ident, pc_cons_arity = 2, pc_arg_types = [type_var_with_attr, list_type], pc_args_strictness=cons_strictness, pc_cons_prio = NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id} - nil_def = { pc_cons_name = nil_ident, pc_cons_arity = 0, pc_arg_types = [], pc_args_strictness=NotStrict, + nil_def = { pc_cons_ident = nil_ident, pc_cons_arity = 0, pc_arg_types = [], pc_args_strictness=NotStrict, pc_cons_prio = NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id} = (list_def,ParsedConstructorToConsDef cons_def,ParsedConstructorToConsDef nil_def,pre_def_symbols); @@ -513,7 +513,7 @@ buildPredefinedModule pre_def_symbols (type_defs, cons_defs, pre_def_symbols) = add_tuple_defs pre_mod_ident MaxTupleArity [array_def,strict_def,unboxed_def] [] pre_def_symbols alias_dummy_type = make_identity_fun_type alias_dummy_ident type_var (class_def, member_def, pre_def_symbols) = make_TC_class_def pre_def_symbols - = ({ mod_name = pre_mod_ident, mod_modification_time = "", mod_type = MK_System, mod_imports = [], mod_imported_objects = [], + = ({ mod_ident = pre_mod_ident, mod_modification_time = "", mod_type = MK_System, mod_imports = [], mod_imported_objects = [], mod_defs = { def_types = [string_def, list_def,strict_list_def,unboxed_list_def,tail_strict_list_def,strict_tail_strict_list_def,unboxed_tail_strict_list_def,overloaded_list_def : type_defs], def_constructors = [cons_def,strict_cons_def,unboxed_cons_def,tail_strict_cons_def,strict_tail_strict_cons_def,unboxed_tail_strict_cons_def,overloaded_cons_def, @@ -530,7 +530,7 @@ where tuple_cons_symb = { ds_ident = tuple_ident, ds_index = MakeTupleConsSymbIndex tup_arity, ds_arity = tup_arity } (tuple_type_def, pre_def_symbols) = make_type_def (GetTupleTypeIndex tup_arity) type_vars (AlgType [tuple_cons_symb]) pre_def_symbols - tuple_cons_def = { pc_cons_name = tuple_ident, pc_cons_arity = tup_arity, pc_cons_pos = PreDefPos pre_mod_id, + tuple_cons_def = { pc_cons_ident = tuple_ident, pc_cons_arity = tup_arity, pc_cons_pos = PreDefPos pre_mod_id, pc_arg_types = [ MakeAttributedType (TV tv) \\ tv <- type_vars], pc_args_strictness = NotStrict, pc_cons_prio = NoPrio, pc_exi_vars = []} @@ -557,10 +557,10 @@ where tc_types = [ TV class_var ], tc_var = nilPtr}], st_attr_vars = [], st_attr_env = [] } - member_def = { me_symb = tc_member_name, me_type = me_type, me_pos = NoPos, me_priority = NoPrio, + member_def = { me_ident = tc_member_name, me_type = me_type, me_pos = NoPos, me_priority = NoPrio, me_offset = NoIndex, me_class_vars = [], me_class = { glob_module = NoIndex, glob_object = NoIndex}, me_type_ptr = nilPtr } - class_def = { class_name = tc_class_name, class_arity = 1, class_args = [class_var], class_context = [], + class_def = { class_ident = tc_class_name, class_arity = 1, class_args = [class_var], class_context = [], class_members = {{ds_ident = tc_member_name, ds_index = cTCMemberSymbIndex, ds_arity = 0 }}, class_cons_vars = 0, class_dictionary = { ds_ident = { tc_class_name & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex }, class_pos = NoPos, class_arg_kinds = [] } @@ -572,7 +572,7 @@ where # a = { at_attribute = TA_Anonymous, at_type = TV type_var } id_symbol_type = { st_vars = [], st_args = [a], st_args_strictness = Strict 1, st_arity = 1, st_result = a, st_context = [], st_attr_vars = [], st_attr_env = [] } // !.a -> .a - = { ft_symb = alias_dummy_id, ft_arity = 1, ft_priority = NoPrio, ft_type = id_symbol_type, ft_pos = NoPos, + = { ft_ident = alias_dummy_id, ft_arity = 1, ft_priority = NoPrio, ft_type = id_symbol_type, ft_pos = NoPos, ft_specials = SP_None, ft_type_ptr = nilPtr } DynamicRepresentation_String :== "DynamicTemp" // "_DynamicTemp" diff --git a/frontend/refmark.icl b/frontend/refmark.icl index a452c7b..1034f21 100644 --- a/frontend/refmark.icl +++ b/frontend/refmark.icl @@ -47,23 +47,23 @@ contains x [y:ys] = x == y || contains x ys saveOccurrences free_vars var_heap = foldSt (foldSt save_occurrence) free_vars var_heap // (free_vars ===> ("saveOccurrences", free_vars)) var_heap where - save_occurrence {fv_name,fv_info_ptr} var_heap + save_occurrence {fv_ident,fv_info_ptr} var_heap # (VI_Occurrence old_occ=:{occ_ref_count,occ_previous}, var_heap) = readPtr fv_info_ptr var_heap = var_heap <:= (fv_info_ptr, VI_Occurrence {old_occ & occ_ref_count = RC_Unused, occ_previous = [occ_ref_count : occ_previous] } ) - ===> ("save_occurrence", fv_name, fv_info_ptr, occ_ref_count, length occ_previous) + ===> ("save_occurrence", fv_ident, fv_info_ptr, occ_ref_count, length occ_previous) restoreOccurrences wher free_vars var_heap = foldSt (foldSt (restore_occurrence wher)) (free_vars ===> ("restoreOccurrences", wher, free_vars)) ([], var_heap) where - restore_occurrence wher fv=:{fv_name,fv_info_ptr} (occurrences, var_heap) + restore_occurrence wher fv=:{fv_ident,fv_info_ptr} (occurrences, var_heap) # (VI_Occurrence old_occ=:{occ_ref_count,occ_previous,occ_bind}, var_heap) = readPtr fv_info_ptr var_heap (prev_ref_count, occ_previous) = case occ_previous of [x : xs] -> (x, xs) _ - -> abort ("restoreOccurrences" /* ---> (fv_name, fv_info_ptr, wher) */) + -> abort ("restoreOccurrences" /* ---> (fv_ident, fv_info_ptr, wher) */) var_heap = var_heap <:= (fv_info_ptr, VI_Occurrence {old_occ & occ_ref_count = prev_ref_count, occ_previous = occ_previous }) - = case occ_ref_count ===> ("restore_occurrence", fv_name, fv_info_ptr, (occ_ref_count, prev_ref_count, occ_previous)) of + = case occ_ref_count ===> ("restore_occurrence", fv_ident, fv_info_ptr, (occ_ref_count, prev_ref_count, occ_previous)) of RC_Unused -> (occurrences, var_heap) _ @@ -89,9 +89,9 @@ where = mark_variable pv var_heap = mark_selected_variable sel pvs var_heap - mark_variable {pv_var={fv_name,fv_info_ptr}} var_heap + mark_variable {pv_var={fv_ident,fv_info_ptr}} var_heap # (VI_Occurrence old_occ=:{occ_ref_count,occ_observing = (_, expr_ptr)}, var_heap) = readPtr fv_info_ptr var_heap - = case occ_ref_count ===> ("mark_variable", fv_name) of + = case occ_ref_count ===> ("mark_variable", fv_ident) of RC_Unused # occ_ref_count = RC_Used {rcu_multiply = [], rcu_selectively = [], rcu_uniquely = [expr_ptr]} -> var_heap <:= (fv_info_ptr, VI_Occurrence {old_occ & occ_ref_count = occ_ref_count } ) @@ -101,11 +101,11 @@ where -> var_heap <:= (fv_info_ptr, VI_Occurrence {old_occ & occ_ref_count = occ_ref_count } ) -refMarkOfVariable free_vars sel (VI_Occurrence var_occ) var=:{var_name, var_info_ptr, var_expr_ptr} rms=:{rms_var_heap} +refMarkOfVariable free_vars sel (VI_Occurrence var_occ) var=:{var_ident, var_info_ptr, var_expr_ptr} rms=:{rms_var_heap} # occ_ref_count = adjust_ref_count sel var_occ.occ_ref_count var_expr_ptr rms_var_heap = markPatternVariables sel var_occ.occ_pattern_vars rms_var_heap - = ref_count_of_bindings free_vars var_name var_info_ptr occ_ref_count var_occ { rms & rms_var_heap = rms_var_heap } - ===> ("refMarkOfVariable", var_name, var_occ.occ_ref_count, occ_ref_count, var_occ.occ_pattern_vars) + = ref_count_of_bindings free_vars var_ident var_info_ptr occ_ref_count var_occ { rms & rms_var_heap = rms_var_heap } + ===> ("refMarkOfVariable", var_ident, var_occ.occ_ref_count, occ_ref_count, var_occ.occ_pattern_vars) where adjust_ref_count sel RC_Unused var_expr_ptr | sel == NotASelector @@ -131,20 +131,20 @@ where = [ selection : add_selection var_expr_ptr sel selections ] - ref_count_of_bindings free_vars var_name var_info_ptr occ_ref_count var_occ=:{occ_bind = OB_OpenLet fv let_info} rms=:{rms_var_heap,rms_let_vars} + ref_count_of_bindings free_vars var_ident var_info_ptr occ_ref_count var_occ=:{occ_bind = OB_OpenLet fv let_info} rms=:{rms_var_heap,rms_let_vars} # rms_var_heap = rms_var_heap <:= (var_info_ptr, VI_Occurrence { var_occ & occ_ref_count = occ_ref_count, occ_bind = OB_LockedLet var_occ.occ_bind }) = { rms & rms_var_heap = rms_var_heap, rms_let_vars = [ fv : rms_let_vars ]} - ===> ("ref_count_of_bindings (OB_OpenLet)", var_name) - ref_count_of_bindings free_vars var_name var_info_ptr occ_ref_count var_occ=:{occ_bind = OB_LockedLet _} rms=:{rms_var_heap} + ===> ("ref_count_of_bindings (OB_OpenLet)", var_ident) + ref_count_of_bindings free_vars var_ident var_info_ptr occ_ref_count var_occ=:{occ_bind = OB_LockedLet _} rms=:{rms_var_heap} = { rms & rms_var_heap = rms_var_heap <:= (var_info_ptr, VI_Occurrence { var_occ & occ_ref_count = occ_ref_count })} -// ===> ("ref_count_of_bindings (OB_LockedLet)", var_name) - ref_count_of_bindings free_vars var_name var_info_ptr occ_ref_count var_occ rms=:{rms_var_heap} +// ===> ("ref_count_of_bindings (OB_LockedLet)", var_ident) + ref_count_of_bindings free_vars var_ident var_info_ptr occ_ref_count var_occ rms=:{rms_var_heap} = { rms & rms_var_heap = rms_var_heap <:= (var_info_ptr, VI_Occurrence { var_occ & occ_ref_count = occ_ref_count })} addParRefMarksOfLets call let_vars closed_vars_end_rms = foldSt ref_mark_of_let let_vars closed_vars_end_rms where - ref_mark_of_let fv=:{fv_name,fv_info_ptr} (closed_let_vars, rms=:{rms_var_heap}) + ref_mark_of_let fv=:{fv_ident,fv_info_ptr} (closed_let_vars, rms=:{rms_var_heap}) # (VI_Occurrence var_occ, rms_var_heap) = readPtr fv_info_ptr rms_var_heap rms = { rms & rms_var_heap = rms_var_heap } = case var_occ.occ_bind of @@ -152,32 +152,32 @@ where # rms_var_heap = rms.rms_var_heap <:= (fv_info_ptr, VI_Occurrence {var_occ & occ_bind = OB_LockedLet var_occ.occ_bind}) rms_var_heap = addParRefCounts call ref_counts rms_var_heap -> addParRefMarksOfLets call let_vars ([fv : closed_let_vars], {rms & rms_var_heap = rms_var_heap}) - ===> ("addParRefMarksOfLets (OB_OpenLet Yes)", fv_name) + ===> ("addParRefMarksOfLets (OB_OpenLet Yes)", fv_ident) OB_OpenLet _ No # rms_var_heap = rms.rms_var_heap <:= (fv_info_ptr, VI_Occurrence {var_occ & occ_bind = OB_LockedLet var_occ.occ_bind}) -> (closed_let_vars, { rms & rms_var_heap = rms_var_heap, rms_let_vars = [fv : rms.rms_let_vars]}) - ===> ("addParRefMarksOfLets (OB_OpenLet No)", fv_name) + ===> ("addParRefMarksOfLets (OB_OpenLet No)", fv_ident) OB_LockedLet _ -> (closed_let_vars, rms) - ===> ("addParRefMarksOfLets (OB_LockedLet)", fv_name) + ===> ("addParRefMarksOfLets (OB_LockedLet)", fv_ident) addParRefCounts call ref_counts var_heap = foldSt (set_occurrence call) ref_counts var_heap where - set_occurrence call {cfv_var = {fv_name,fv_info_ptr}, cfv_count} var_heap + set_occurrence call {cfv_var = {fv_ident,fv_info_ptr}, cfv_count} var_heap # (VI_Occurrence occ=:{occ_ref_count}, var_heap) = readPtr fv_info_ptr var_heap comb_ref_count = parCombineRefCount occ_ref_count cfv_count = var_heap <:= (fv_info_ptr, VI_Occurrence { occ & occ_ref_count = comb_ref_count}) - ===> ("addParRefCounts", call, fv_name, fv_info_ptr, (cfv_count, occ_ref_count, comb_ref_count)) + ===> ("addParRefCounts", call, fv_ident, fv_info_ptr, (cfv_count, occ_ref_count, comb_ref_count)) addSeqRefCounts ref_counts var_heap = foldSt set_occurrence ref_counts var_heap where - set_occurrence {cfv_var = {fv_name,fv_info_ptr}, cfv_count} var_heap + set_occurrence {cfv_var = {fv_ident,fv_info_ptr}, cfv_count} var_heap # (VI_Occurrence occ=:{occ_ref_count}, var_heap) = readPtr fv_info_ptr var_heap comb_ref_count = seqCombineRefCount occ_ref_count cfv_count = var_heap <:= (fv_info_ptr, VI_Occurrence { occ & occ_ref_count = comb_ref_count}) - ===> ("addSeqRefCounts", fv_name, cfv_count, occ_ref_count, comb_ref_count) + ===> ("addSeqRefCounts", fv_ident, cfv_count, occ_ref_count, comb_ref_count) instance refMark BoundVar where refMark free_vars sel _ var rms=:{rms_var_heap} @@ -226,13 +226,13 @@ where let_combine free_vars var_heap = foldSt (foldSt let_combine_ref_count) free_vars var_heap where - let_combine_ref_count {fv_name,fv_info_ptr} var_heap + let_combine_ref_count {fv_ident,fv_info_ptr} var_heap # (VI_Occurrence old_occ=:{occ_ref_count,occ_previous=[prev_ref_count, pre_pref_recount:occ_previouses]}, var_heap) = readPtr fv_info_ptr var_heap seq_comb_ref_count = seqCombineRefCount occ_ref_count prev_ref_count comb_ref_count = parCombineRefCount seq_comb_ref_count pre_pref_recount = (var_heap <:= (fv_info_ptr, VI_Occurrence { old_occ & occ_ref_count = comb_ref_count, occ_previous = occ_previouses })) - ===> ("let_combine_ref_count", fv_name, (pre_pref_recount, prev_ref_count, occ_ref_count, seq_comb_ref_count, comb_ref_count)) + ===> ("let_combine_ref_count", fv_ident, (pre_pref_recount, prev_ref_count, occ_ref_count, seq_comb_ref_count, comb_ref_count)) init_let_binds let_binds var_heap = foldSt bind_variable let_binds var_heap @@ -331,12 +331,12 @@ where openLetVars let_vars var_heap = foldSt open_let_vars let_vars var_heap where - open_let_vars {fv_name,fv_info_ptr} var_heap + open_let_vars {fv_ident,fv_info_ptr} var_heap # (VI_Occurrence var_occ, var_heap) = readPtr fv_info_ptr var_heap = case var_occ.occ_bind of OB_LockedLet occ_bind -> var_heap <:= (fv_info_ptr, VI_Occurrence { var_occ & occ_bind = occ_bind }) -// ===> ("openLetVars (OB_LockedLet)", fv_name) +// ===> ("openLetVars (OB_LockedLet)", fv_ident) _ -> abort "open_let_vars (refmark.icl))" @@ -383,7 +383,7 @@ where (all_closed_let_vars, rms) = refMarkOfAlternative free_vars new_free_vars sel def case_expr dp_rhs all_closed_let_vars rms = (inc pattern_depth, all_closed_let_vars, rms) -refMarkOfAlgebraicOrOverloadedListCase free_vars sel def (Var var=:{var_name,var_info_ptr,var_expr_ptr}) alternatives case_explicit case_default rms +refMarkOfAlgebraicOrOverloadedListCase free_vars sel def (Var var=:{var_ident,var_info_ptr,var_expr_ptr}) alternatives case_explicit case_default rms # (def, all_closed_let_vars, rms) = ref_mark_of_default case_explicit free_vars sel def var case_default [] rms (pattern_depth, all_closed_let_vars, rms) = foldSt (ref_mark_of_algebraic_pattern free_vars sel var def) alternatives (0, all_closed_let_vars, rms) (let_vars_in_default, rms_var_heap) = addRefMarkOfDefault pattern_depth free_vars def rms.rms_var_heap @@ -427,7 +427,7 @@ where # (VI_Occurrence var_occ, var_heap) = readPtr var_info_ptr var_heap = var_heap <:= (var_info_ptr, VI_Occurrence { var_occ & occ_pattern_vars = tl var_occ.occ_pattern_vars }) - ref_mark_of_variable_pattern do_seq_combine {var_name,var_info_ptr,var_expr_ptr} (closed_lets, rms=:{rms_var_heap}) + ref_mark_of_variable_pattern do_seq_combine {var_ident,var_info_ptr,var_expr_ptr} (closed_lets, rms=:{rms_var_heap}) # (VI_Occurrence var_occ_in_alts, rms_var_heap) = readPtr var_info_ptr rms_var_heap (var_occ_in_alts, rms_var_heap) = adjust_ref_count_of_variable_pattern var_occ_in_alts var_info_ptr var_expr_ptr rms_var_heap = add_let_variable do_seq_combine var_info_ptr var_occ_in_alts (closed_lets, { rms & rms_var_heap = rms_var_heap }) @@ -499,7 +499,7 @@ where addSeqRefMarksOfLets let_vars closed_vars_end_rms = foldSt ref_mark_of_let let_vars closed_vars_end_rms where - ref_mark_of_let fv=:{fv_name,fv_info_ptr} (closed_let_vars, rms=:{rms_var_heap}) + ref_mark_of_let fv=:{fv_ident,fv_info_ptr} (closed_let_vars, rms=:{rms_var_heap}) # (VI_Occurrence var_occ, rms_var_heap) = readPtr fv_info_ptr rms_var_heap rms = { rms & rms_var_heap = rms_var_heap } = case var_occ.occ_bind of @@ -507,14 +507,14 @@ where # rms_var_heap = rms.rms_var_heap <:= (fv_info_ptr, VI_Occurrence {var_occ & occ_bind = OB_LockedLet var_occ.occ_bind}) rms_var_heap = addSeqRefCounts ref_counts rms_var_heap -> addSeqRefMarksOfLets let_vars ([fv : closed_let_vars], {rms & rms_var_heap = rms_var_heap}) -// ===> ("addSeqRefMarksOfLets (OB_OpenLet Yes)", fv_name) +// ===> ("addSeqRefMarksOfLets (OB_OpenLet Yes)", fv_ident) OB_OpenLet fv No # rms_var_heap = rms.rms_var_heap <:= (fv_info_ptr, VI_Occurrence {var_occ & occ_bind = OB_LockedLet var_occ.occ_bind}) -> (closed_let_vars, { rms & rms_var_heap = rms_var_heap, rms_let_vars = [fv : rms.rms_let_vars]}) -// ===> ("addSeqRefMarksOfLets (OB_OpenLet No)", fv_name) +// ===> ("addSeqRefMarksOfLets (OB_OpenLet No)", fv_ident) OB_LockedLet _ -> (closed_let_vars, rms) -// ===> ("addSeqRefMarksOfLets (OB_LockedLet)", fv_name) +// ===> ("addSeqRefMarksOfLets (OB_LockedLet)", fv_ident) addRefMarkOfDefault :: !Int ![[FreeVar]] !(Optional [CountedFreeVar]) !*VarHeap -> *(![FreeVar], !*VarHeap) @@ -523,10 +523,10 @@ addRefMarkOfDefault pattern_depth free_vars (Yes occurrences) var_heap # (open_let_vars, var_heap) = foldSt set_occurrence occurrences ([], var_heap) = (open_let_vars, altCombine (inc pattern_depth) free_vars var_heap) where - set_occurrence {cfv_var=fv=:{fv_name,fv_info_ptr}, cfv_count, cfv_is_let} (open_let_vars, var_heap) + set_occurrence {cfv_var=fv=:{fv_ident,fv_info_ptr}, cfv_count, cfv_is_let} (open_let_vars, var_heap) # (VI_Occurrence old_occ, var_heap) = readPtr fv_info_ptr var_heap = (cond_add cfv_is_let fv open_let_vars, var_heap <:= (fv_info_ptr, VI_Occurrence {old_occ & occ_ref_count = cfv_count } )) - ===> ("set_occurrence", fv_name, cfv_count) + ===> ("set_occurrence", fv_ident, cfv_count) where cond_add cond var vars | cond @@ -539,35 +539,35 @@ addRefMarkOfDefault pattern_depth free_vars No var_heap parCombine free_vars var_heap = foldSt (foldSt par_combine) free_vars (var_heap===> ("parCombine", free_vars)) where - par_combine {fv_name,fv_info_ptr} var_heap + par_combine {fv_ident,fv_info_ptr} var_heap # (VI_Occurrence old_occ, var_heap) = readPtr fv_info_ptr var_heap = case old_occ.occ_previous of [glob_ref_count : occ_previous] # comb_ref_count = parCombineRefCount old_occ.occ_ref_count glob_ref_count -> var_heap <:= (fv_info_ptr, VI_Occurrence { old_occ & occ_ref_count = comb_ref_count , occ_previous = occ_previous }) - ===> ("par_combine", fv_name, old_occ.occ_ref_count, glob_ref_count, comb_ref_count) + ===> ("par_combine", fv_ident, old_occ.occ_ref_count, glob_ref_count, comb_ref_count) _ - -> abort ("inconsistent reference count administration" ===> fv_name) + -> abort ("inconsistent reference count administration" ===> fv_ident) seqCombine free_vars var_heap = foldSt (foldSt seq_combine) free_vars (var_heap===> ("seqCombine", free_vars)) where - seq_combine {fv_name,fv_info_ptr} var_heap + seq_combine {fv_ident,fv_info_ptr} var_heap # (VI_Occurrence pattern_occ, var_heap) = readPtr fv_info_ptr var_heap = case pattern_occ.occ_previous of [alt_ref_count : occ_previous] # comb_ref_count = seqCombineRefCount alt_ref_count pattern_occ.occ_ref_count -> var_heap <:= (fv_info_ptr, VI_Occurrence { pattern_occ & occ_ref_count = comb_ref_count , occ_previous = occ_previous }) - ===> ("seq_combine", fv_name, pattern_occ.occ_ref_count, alt_ref_count, comb_ref_count) + ===> ("seq_combine", fv_ident, pattern_occ.occ_ref_count, alt_ref_count, comb_ref_count) _ - -> abort ("inconsistent reference count administration" ===> fv_name) + -> abort ("inconsistent reference count administration" ===> fv_ident) altCombine depth free_vars var_heap = foldSt (foldSt (alt_combine depth)) free_vars (var_heap ===> ("altCombine", free_vars)) where - alt_combine depth {fv_name,fv_info_ptr} var_heap + alt_combine depth {fv_ident,fv_info_ptr} var_heap # (VI_Occurrence old_occ=:{occ_ref_count,occ_previous}, var_heap) = readPtr fv_info_ptr var_heap - (occ_ref_count, occ_previous) = alt_combine_ref_counts occ_ref_count occ_previous ((dec depth) ===> ("alt_combine", fv_name, occ_ref_count, length occ_previous, depth)) + (occ_ref_count, occ_previous) = alt_combine_ref_counts occ_ref_count occ_previous ((dec depth) ===> ("alt_combine", fv_ident, occ_ref_count, length occ_previous, depth)) = var_heap <:= (fv_info_ptr, VI_Occurrence { old_occ & occ_ref_count = occ_ref_count , occ_previous = occ_previous }) alt_combine_ref_counts comb_ref_count ref_counts 0 @@ -677,12 +677,12 @@ makeSharedReferencesNonUnique [fun : funs] fun_defs coercion_env subst type_def_ = make_shared_references_of_funcion_non_unique fun_def coercion_env subst type_def_infos var_heap expr_heap error = makeSharedReferencesNonUnique funs fun_defs coercion_env subst type_def_infos var_heap expr_heap error where - make_shared_references_of_funcion_non_unique {fun_symb, fun_pos, fun_body = TransformedBody {tb_args,tb_rhs},fun_info={fi_local_vars}} + make_shared_references_of_funcion_non_unique {fun_ident, fun_pos, fun_body = TransformedBody {tb_args,tb_rhs},fun_info={fi_local_vars}} coercion_env subst type_def_infos var_heap expr_heap error # variables = tb_args ++ fi_local_vars (subst, type_def_infos, var_heap, expr_heap) = clear_occurrences variables subst type_def_infos var_heap expr_heap - (_, {rms_var_heap}) = fullRefMark [tb_args] NotASelector No /* tb_rhs var_heap */ (tb_rhs ===> ("makeSharedReferencesNonUnique", fun_symb, tb_rhs)) var_heap - position = newPosition fun_symb fun_pos + (_, {rms_var_heap}) = fullRefMark [tb_args] NotASelector No /* tb_rhs var_heap */ (tb_rhs ===> ("makeSharedReferencesNonUnique", fun_ident, tb_rhs)) var_heap + position = newPosition fun_ident fun_pos (coercion_env, var_heap, expr_heap, error) = make_shared_vars_non_unique variables coercion_env rms_var_heap expr_heap (setErrorAdmin position error) var_heap = empty_occurrences variables var_heap @@ -692,7 +692,7 @@ where clear_occurrences vars subst type_def_infos var_heap expr_heap = foldSt initial_occurrence vars (subst, type_def_infos, var_heap, expr_heap) where - initial_occurrence {fv_name,fv_info_ptr} (subst, type_def_infos, var_heap, expr_heap) + initial_occurrence {fv_ident,fv_info_ptr} (subst, type_def_infos, var_heap, expr_heap) # (var_info, var_heap) = readPtr fv_info_ptr var_heap {at_type, at_attribute} = get_type var_info (expr_ptr, expr_heap) = newPtr (EI_Attribute (toInt at_attribute)) expr_heap @@ -724,7 +724,7 @@ where make_shared_vars_non_unique vars coercion_env var_heap expr_heap error = foldl make_shared_var_non_unique (coercion_env, var_heap, expr_heap, error) vars - make_shared_var_non_unique (coercion_env, var_heap, expr_heap, error) fv=:{fv_name,fv_info_ptr} + make_shared_var_non_unique (coercion_env, var_heap, expr_heap, error) fv=:{fv_ident,fv_info_ptr} # (VI_Occurrence occ, var_heap) = readPtr fv_info_ptr var_heap = case occ.occ_ref_count of RC_Used {rcu_multiply,rcu_selectively} @@ -733,7 +733,7 @@ where -> (coercion_env, var_heap, expr_heap, error) _ -> (coercion_env, var_heap, expr_heap, error) -// ===> ("make_shared_var_non_unique", fv_name) +// ===> ("make_shared_var_non_unique", fv_ident) make_shared_occurrences_non_unique fv multiply (coercion_env, expr_heap, error) = foldSt (make_shared_occurrence_non_unique fv) multiply (coercion_env, expr_heap, error) diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl index 62923d4..c30348f 100644 --- a/frontend/syntax.dcl +++ b/frontend/syntax.dcl @@ -90,7 +90,7 @@ instance == FunctionOrMacroIndex } :: Module defs = - { mod_name :: !Ident + { mod_ident :: !Ident , mod_modification_time :: {#Char} , mod_type :: !ModuleKind , mod_imports :: ![ParsedImport] @@ -187,8 +187,8 @@ cNameNotLocationDependent :== False cNameLocationDependent :== True :: ParsedSelector = - { ps_field_name :: !Ident - , ps_selector_name :: !Ident + { ps_field_ident :: !Ident + , ps_selector_ident :: !Ident , ps_field_annotation :: !Annotation , ps_field_type :: !AType , ps_field_var :: !Ident @@ -196,7 +196,7 @@ cNameLocationDependent :== True } :: ParsedConstructor = - { pc_cons_name :: !Ident + { pc_cons_ident :: !Ident , pc_cons_arity :: !Int , pc_exi_vars :: ![ATypeVar] , pc_arg_types :: ![AType] @@ -260,7 +260,7 @@ cNameLocationDependent :== True } :: ClassDef = - { class_name :: !Ident + { class_ident :: !Ident , class_arity :: !Int , class_args :: ![TypeVar] , class_context :: ![TypeContext] @@ -274,7 +274,7 @@ cNameLocationDependent :== True :: ClassDefInfos :== {# .{! [TypeKind]}} :: MemberDef = - { me_symb :: !Ident + { me_ident :: !Ident , me_class :: !Global Index , me_offset :: !Index , me_type :: !SymbolType @@ -287,8 +287,8 @@ cNameLocationDependent :== True // AA ... :: GenericDef = - { gen_name :: !Ident // the generics name in IC_Class - , gen_member_name :: !Ident // the generics name in IC_Member + { gen_ident :: !Ident // the generics name in IC_Class + , gen_member_ident :: !Ident // the generics name in IC_Member , gen_pos :: !Position , gen_type :: !SymbolType // Generic type (st_vars include generic type vars) , gen_vars :: ![TypeVar] // Generic type variables @@ -319,8 +319,8 @@ cNameLocationDependent :== True | TypeConsVar TypeVar :: GenericCaseDef = - { gc_name :: !Ident // name in IC_GenricCase namespace - , gc_gname :: !Ident // name in IC_Generic namespace + { gc_ident :: !Ident // name in IC_GenricCase namespace + , gc_gident :: !Ident // name in IC_Generic namespace , gc_generic :: !GlobalIndex // index of the generic , gc_arity :: !Int // arity of the function , gc_pos :: !Position // position in the source file @@ -406,7 +406,7 @@ cIsImportedObject :== False } :: FieldSymbol = - { fs_name :: !Ident + { fs_ident :: !Ident , fs_var :: !Ident , fs_index :: !Index } @@ -433,7 +433,7 @@ cIsAnalysed :== 4 NoGlobalIndex :== {gi_module=NoIndex,gi_index=NoIndex} :: TypeDef type_rhs = - { td_name :: !Ident + { td_ident :: !Ident , td_index :: !Int , td_arity :: !Int , td_args :: ![ATypeVar] @@ -478,7 +478,7 @@ NoGlobalIndex :== {gi_module=NoIndex,gi_index=NoIndex} :: TypeDefInfos :== {# .{# TypeDefInfo}} :: FunType = - { ft_symb :: !Ident + { ft_ident :: !Ident , ft_arity :: !Int , ft_priority :: !Priority , ft_type :: !SymbolType @@ -489,7 +489,7 @@ NoGlobalIndex :== {gi_module=NoIndex,gi_index=NoIndex} :: FreeVar = { fv_def_level :: !Level - , fv_name :: !Ident + , fv_ident :: !Ident , fv_info_ptr :: !VarInfoPtr // , fv_expr_ptr :: !ExprInfoPtr , fv_count :: !Int @@ -556,7 +556,7 @@ FI_IsUnboxedListOfRecordsConsOrNil :== 8 } :: FunDef = - { fun_symb :: !Ident + { fun_ident :: !Ident , fun_arity :: !Int , fun_priority :: !Priority , fun_body :: !FunctionBody @@ -649,7 +649,7 @@ from convertcases import :: LetVarInfo, :: LetExpressionInfo, cNotVarNumber :== -1 :: BoundVar = - { var_name :: !Ident + { var_ident :: !Ident , var_info_ptr :: !VarInfoPtr , var_expr_ptr :: !ExprInfoPtr } @@ -662,7 +662,7 @@ cNonRecursiveAppl :== False */ :: TypeSymbIdent = - { type_name :: !Ident + { type_ident :: !Ident , type_arity :: !Int , type_index :: !Global Index , type_prop :: !TypeSymbProperties @@ -821,12 +821,12 @@ cNonRecursiveAppl :== False } :: SymbIdent = - { symb_name :: !Ident + { symb_ident :: !Ident , symb_kind :: !SymbKind } :: ConsDef = - { cons_symb :: !Ident + { cons_ident :: !Ident , cons_type :: !SymbolType , cons_arg_vars :: ![[ATypeVar]] , cons_priority :: !Priority @@ -839,7 +839,7 @@ cNonRecursiveAppl :== False } :: SelectorDef = - { sd_symb :: !Ident + { sd__ident :: !Ident , sd_field :: !Ident , sd_type :: !SymbolType , sd_exi_vars :: ![ATypeVar] @@ -971,7 +971,7 @@ cNonRecursiveAppl :== False } :: TypeVar = - { tv_name :: !Ident + { tv_ident :: !Ident , tv_info_ptr :: !TypeVarInfoPtr } @@ -987,7 +987,7 @@ cNonRecursiveAppl :== False | TA_PA_BUG :: AttributeVar = - { av_name :: !Ident + { av_ident :: !Ident , av_info_ptr :: !AttrVarInfoPtr } @@ -1383,8 +1383,8 @@ cNotAGroupNumber :== -1 EmptyTypeDefInfo :== { tdi_kinds = [], tdi_properties = cAllBitsClear, tdi_group = [], tdi_group_vars = [], tdi_cons_vars = [], tdi_classification = EmptyTypeClassification, tdi_group_nr = cNotAGroupNumber, tdi_index_in_group = NoIndex, tdi_mark=False, tdi_gen_rep = No } -MakeTypeVar name :== { tv_name = name, tv_info_ptr = nilPtr } -MakeVar name :== { var_name = name, var_info_ptr = nilPtr, var_expr_ptr = nilPtr } +MakeTypeVar name :== { tv_ident = name, tv_info_ptr = nilPtr } +MakeVar name :== { var_ident = name, var_info_ptr = nilPtr, var_expr_ptr = nilPtr } MakeAttributedType type :== { at_attribute = TA_None, at_type = type } MakeAttributedTypeVar type_var :== { atv_attribute = TA_None, atv_variable = type_var } @@ -1401,19 +1401,19 @@ PropClass :== bitnot 0 newTypeSymbIdentCAF :: TypeSymbIdent; MakeNewTypeSymbIdent name arity - :== {newTypeSymbIdentCAF & type_name=name, type_arity=arity } + :== {newTypeSymbIdentCAF & type_ident=name, type_arity=arity } MakeTypeSymbIdent type_index name arity - :== { newTypeSymbIdentCAF & type_name = name, type_arity = arity, type_index = type_index } + :== { newTypeSymbIdentCAF & type_ident = name, type_arity = arity, type_index = type_index } ParsedSelectorToSelectorDef sd_type_index ps :== - { sd_symb = ps.ps_selector_name, sd_field_nr = NoIndex, sd_pos = ps.ps_field_pos, sd_type_index = sd_type_index, - sd_exi_vars = [], sd_type_ptr = nilPtr, sd_field = ps.ps_field_name, + { sd__ident = ps.ps_selector_ident, sd_field_nr = NoIndex, sd_pos = ps.ps_field_pos, sd_type_index = sd_type_index, + sd_exi_vars = [], sd_type_ptr = nilPtr, sd_field = ps.ps_field_ident, sd_type = { st_vars = [], st_args = [], st_args_strictness=NotStrict, st_result = ps.ps_field_type, st_arity = 0, st_context = [], st_attr_env = [], st_attr_vars = [] }} ParsedConstructorToConsDef pc :== - { cons_symb = pc.pc_cons_name, cons_pos = pc.pc_cons_pos, cons_priority = pc.pc_cons_prio, cons_index = NoIndex, cons_type_index = NoIndex, + { cons_ident = pc.pc_cons_ident, cons_pos = pc.pc_cons_pos, cons_priority = pc.pc_cons_prio, cons_index = NoIndex, cons_type_index = NoIndex, cons_type = { st_vars = [], st_args = pc.pc_arg_types, st_args_strictness=pc.pc_args_strictness, st_result = MakeAttributedType TE, st_arity = pc.pc_cons_arity, st_context = [], st_attr_env = [], st_attr_vars = []}, cons_exi_vars = pc.pc_exi_vars, cons_type_ptr = nilPtr, cons_arg_vars = [] } @@ -1425,12 +1425,12 @@ ParsedInstanceToClassInstance pi members :== ins_members = members, ins_specials = pi.pi_specials, ins_pos = pi.pi_pos} MakeTypeDef name lhs rhs attr contexts pos :== - { td_name = name, td_index = -1, td_arity = length lhs, td_args = lhs, td_attrs = [], td_attribute = attr, td_context = contexts, + { td_ident = name, td_index = -1, td_arity = length lhs, td_args = lhs, td_attrs = [], td_attribute = attr, td_context = contexts, td_pos = pos, td_rhs = rhs, td_used_types = [] } MakeDefinedSymbol ident index arity :== { ds_ident = ident, ds_arity = arity, ds_index = index } MakeNewFunctionType name arity prio type pos specials var_ptr - :== { ft_symb = name, ft_arity = arity, ft_priority = prio, ft_type = type, ft_pos = pos, ft_specials = specials, ft_type_ptr = var_ptr } + :== { ft_ident = name, ft_arity = arity, ft_priority = prio, ft_type = type, ft_pos = pos, ft_specials = specials, ft_type_ptr = var_ptr } backslash :== '\\' diff --git a/frontend/syntax.icl b/frontend/syntax.icl index 87c7ee2..2195962 100644 --- a/frontend/syntax.icl +++ b/frontend/syntax.icl @@ -24,7 +24,7 @@ class needs_brackets a :: a -> Bool instance == BoundVar where (==) varid1 varid2 - = varid1.var_name == varid2.var_name + = varid1.var_ident == varid2.var_ident instance == Ident where @@ -88,18 +88,18 @@ where instance <<< TypeVar where -// (<<<) file varid = file <<< varid.tv_name - (<<<) file varid = file <<< varid.tv_name <<< "<" <<< varid.tv_info_ptr <<< ">" +// (<<<) file varid = file <<< varid.tv_ident + (<<<) file varid = file <<< varid.tv_ident <<< "<" <<< varid.tv_info_ptr <<< ">" instance <<< AttributeVar where - (<<<) file {av_name,av_info_ptr} = file <<< av_name <<< "[" <<< av_info_ptr <<< "]" -// (<<<) file {av_name,av_info_ptr} = file <<< av_name + (<<<) file {av_ident,av_info_ptr} = file <<< av_ident <<< "[" <<< av_info_ptr <<< "]" +// (<<<) file {av_ident,av_info_ptr} = file <<< av_ident instance toString AttributeVar where - toString {av_name,av_info_ptr} = toString av_name + "[" + toString (ptrToInt av_info_ptr) + "]" -// toString {av_name,av_info_ptr} = toString av_name + toString {av_ident,av_info_ptr} = toString av_ident + "[" + toString (ptrToInt av_info_ptr) + "]" +// toString {av_ident,av_info_ptr} = toString av_ident instance <<< AType where @@ -262,21 +262,21 @@ where instance <<< SymbIdent where (<<<) file symb=:{symb_kind = SK_Function symb_index } - = file <<< symb.symb_name <<< '@' <<< symb_index + = file <<< symb.symb_ident <<< '@' <<< symb_index (<<<) file symb=:{symb_kind = SK_LocalMacroFunction symb_index } - = file <<< symb.symb_name <<< "[lm]@" <<< symb_index + = file <<< symb.symb_ident <<< "[lm]@" <<< symb_index (<<<) file symb=:{symb_kind = SK_GeneratedFunction _ symb_index } - = file <<< symb.symb_name <<< "[g]@" <<< symb_index + = file <<< symb.symb_ident <<< "[g]@" <<< symb_index (<<<) file symb=:{symb_kind = SK_LocalDclMacroFunction symb_index } - = file <<< symb.symb_name <<< "[ldm]@" <<< symb_index + = file <<< symb.symb_ident <<< "[ldm]@" <<< symb_index (<<<) file symb=:{symb_kind = SK_OverloadedFunction symb_index } - = file <<< symb.symb_name <<< "[o]@" <<< symb_index + = file <<< symb.symb_ident <<< "[o]@" <<< symb_index (<<<) file symb - = file <<< symb.symb_name + = file <<< symb.symb_ident instance <<< TypeSymbIdent where - (<<<) file symb = file <<< symb.type_name <<< '.' <<< symb.type_index + (<<<) file symb = file <<< symb.type_ident <<< '.' <<< symb.type_index /* instance <<< ClassSymbIdent where @@ -284,8 +284,8 @@ where */ instance <<< BoundVar where - (<<<) file {var_name,var_info_ptr,var_expr_ptr} - = file <<< var_name <<< "<I" <<< var_info_ptr <<< ", E" <<< var_expr_ptr <<< '>' + (<<<) file {var_ident,var_info_ptr,var_expr_ptr} + = file <<< var_ident <<< "<I" <<< var_info_ptr <<< ", E" <<< var_expr_ptr <<< '>' instance <<< (Bind a b) | <<< a & <<< b where @@ -397,7 +397,7 @@ where (<<<) file (ABCCodeExpr code_sequence do_inline) = file <<< (if do_inline "code inline\n" "code\n") <<< code_sequence (<<<) file (AnyCodeExpr input output code_sequence) = file <<< "code\n" <<< input <<< "\n" <<< output <<< "\n" <<< code_sequence - (<<<) file (FreeVar {fv_name}) = file <<< fv_name + (<<<) file (FreeVar {fv_ident}) = file <<< fv_ident (<<<) file (ClassVariable info_ptr) = file <<< "ClassVariable " <<< info_ptr (<<<) file (FailExpr _) = file <<< "** FAIL **" @@ -560,25 +560,25 @@ where instance <<< FunType where - (<<<) file {ft_symb,ft_type} = file <<< ft_symb <<< "::" <<< ft_type + (<<<) file {ft_ident,ft_type} = file <<< ft_ident <<< "::" <<< ft_type instance <<< FunDef where - (<<<) file {fun_symb,fun_body=ParsedBody bodies} = file <<< fun_symb <<< '.' <<< ' ' <<< bodies - (<<<) file {fun_symb,fun_body=CheckedBody {cb_args,cb_rhs},fun_info={fi_free_vars,fi_def_level,fi_calls}} = file <<< fun_symb <<< '.' + (<<<) file {fun_ident,fun_body=ParsedBody bodies} = file <<< fun_ident <<< '.' <<< ' ' <<< bodies + (<<<) file {fun_ident,fun_body=CheckedBody {cb_args,cb_rhs},fun_info={fi_free_vars,fi_def_level,fi_calls}} = file <<< fun_ident <<< '.' <<< "C " <<< cb_args <<< " = " <<< cb_rhs <<< '\n' // <<< '.' <<< fi_def_level <<< ' ' <<< '[' <<< fi_free_vars <<< ']' <<< cb_args <<< " = " <<< cb_rhs - (<<<) file {fun_symb,fun_body=TransformedBody {tb_args,tb_rhs},fun_info={fi_free_vars,fi_local_vars,fi_def_level,fi_calls}} - = file <<< fun_symb <<< '.' <<< "T " + (<<<) file {fun_ident,fun_body=TransformedBody {tb_args,tb_rhs},fun_info={fi_free_vars,fi_local_vars,fi_def_level,fi_calls}} + = file <<< fun_ident <<< '.' <<< "T " // <<< '[' <<< fi_free_vars <<< "] [" <<< fi_local_vars <<< ']' <<< tb_args <<< '[' <<< fi_calls <<< ']' <<< "\n\t= " <<< tb_rhs <<< '\n' // <<< '.' <<< fi_def_level <<< ' ' <<< '[' <<< fi_free_vars <<< ']' <<< tb_args <<< " = " <<< tb_rhs - (<<<) file {fun_symb,fun_body=BackendBody body,fun_type=Yes type} = file // <<< type <<< '\n' - <<< fun_symb <<< '.' <<< body <<< '\n' - (<<<) file {fun_symb,fun_body=NoBody,fun_type=Yes type} = file // <<< type <<< '\n' - <<< fun_symb <<< '.' <<< "Array function\n" + (<<<) file {fun_ident,fun_body=BackendBody body,fun_type=Yes type} = file // <<< type <<< '\n' + <<< fun_ident <<< '.' <<< body <<< '\n' + (<<<) file {fun_ident,fun_body=NoBody,fun_type=Yes type} = file // <<< type <<< '\n' + <<< fun_ident <<< '.' <<< "Array function\n" - (<<<) file {fun_symb} = file <<< fun_symb <<< "???" <<< '\n' + (<<<) file {fun_ident} = file <<< fun_ident <<< "???" <<< '\n' instance <<< FunctionBody where @@ -602,7 +602,7 @@ where instance <<< FreeVar where - (<<<) file {fv_name,fv_info_ptr,fv_count} = file <<< fv_name <<< '.' <<< fv_count <<< '<' <<< fv_info_ptr <<< '>' + (<<<) file {fv_ident,fv_info_ptr,fv_count} = file <<< fv_ident <<< '.' <<< fv_count <<< '<' <<< fv_info_ptr <<< '>' instance <<< DynamicType where @@ -672,8 +672,8 @@ where instance <<< (TypeDef a) | <<< a where - (<<<) file {td_name, td_args, td_rhs} - = file <<< ":: " <<< td_name <<< ' ' <<< td_args <<< td_rhs + (<<<) file {td_ident, td_args, td_rhs} + = file <<< ":: " <<< td_ident <<< ' ' <<< td_args <<< td_rhs instance <<< TypeRhs where @@ -693,7 +693,7 @@ where instance <<< FieldSymbol where - (<<<) file {fs_name} = file <<< fs_name + (<<<) file {fs_ident} = file <<< fs_ident /* where @@ -720,11 +720,11 @@ where instance <<< ParsedConstructor where - (<<<) file {pc_cons_name,pc_arg_types} = file <<< pc_cons_name <<< pc_arg_types + (<<<) file {pc_cons_ident,pc_arg_types} = file <<< pc_cons_ident <<< pc_arg_types instance <<< ParsedSelector where - (<<<) file {ps_field_name,ps_field_type} = file <<< ps_field_name <<< ps_field_type + (<<<) file {ps_field_ident,ps_field_type} = file <<< ps_field_ident <<< ps_field_type instance <<< ModuleKind @@ -733,15 +733,15 @@ where instance <<< ConsDef where - (<<<) file {cons_symb,cons_type} = file <<< cons_symb <<< " :: " <<< cons_type + (<<<) file {cons_ident,cons_type} = file <<< cons_ident <<< " :: " <<< cons_type instance <<< SelectorDef where - (<<<) file {sd_symb} = file <<< sd_symb + (<<<) file {sd__ident} = file <<< sd__ident instance <<< ClassDef where - (<<<) file {class_name} = file <<< class_name + (<<<) file {class_ident} = file <<< class_ident instance <<< ClassInstance where @@ -754,7 +754,7 @@ where instance <<< (Module a) | <<< a where - (<<<) file {mod_name,mod_type,mod_defs} = file <<< mod_type <<< mod_name <<< mod_defs + (<<<) file {mod_ident,mod_type,mod_defs} = file <<< mod_type <<< mod_ident <<< mod_defs instance <<< (CollectedDefinitions a b) | <<< a & <<< b where @@ -767,8 +767,8 @@ where (<<<) file (PD_NodeDef _ pattern rhs) = file <<< pattern <<< " =: " <<< rhs (<<<) file (PD_TypeSpec _ name prio st sp) = file <<< name <<< st (<<<) file (PD_Type td) = file <<< td - (<<<) file (PD_Generic {gen_name}) = file <<< "generic " <<< gen_name - (<<<) file (PD_GenericCase {gc_name,gc_type_cons}) = file <<< gc_name <<< "{|" <<< gc_type_cons <<< "|}" + (<<<) file (PD_Generic {gen_ident}) = file <<< "generic " <<< gen_ident + (<<<) file (PD_GenericCase {gc_ident,gc_type_cons}) = file <<< gc_ident <<< "{|" <<< gc_type_cons <<< "|}" (<<<) file _ = file @@ -866,14 +866,14 @@ where = file <<< "lifted argument " <<< arg_name <<< " of " <<< readable fun_name (<<<) file (CP_Expression expression) = show_expression file expression where - show_expression file (Var {var_name}) - = file <<< var_name - show_expression file (FreeVar {fv_name}) - = file <<< fv_name - show_expression file (App {app_symb={symb_name}, app_args}) - | symb_name.id_name=="_dummyForStrictAlias" + show_expression file (Var {var_ident}) + = file <<< var_ident + show_expression file (FreeVar {fv_ident}) + = file <<< fv_ident + show_expression file (App {app_symb={symb_ident}, app_args}) + | symb_ident.id_name=="_dummyForStrictAlias" = show_expression file (hd app_args) - = file <<< readable symb_name + = file <<< readable symb_ident show_expression file (fun @ fun_args) = show_expression file fun show_expression file (Case {case_ident=No}) @@ -1016,5 +1016,5 @@ newTypeSymbIdentCAF :: TypeSymbIdent; newTypeSymbIdentCAF =: MakeTypeSymbIdentMacro { glob_object = NoIndex, glob_module = NoIndex } {id_name="",id_info=nilPtr} 0 MakeTypeSymbIdentMacro type_index name arity - :== { type_name = name, type_arity = arity, type_index = type_index, + :== { type_ident = name, type_arity = arity, type_index = type_index, type_prop = { tsp_sign = BottomSignClass, tsp_propagation = NoPropClass, tsp_coercible = True }} diff --git a/frontend/trans.icl b/frontend/trans.icl index 5a10bd5..9466630 100644 --- a/frontend/trans.icl +++ b/frontend/trans.icl @@ -423,8 +423,8 @@ where old_f_a_before = takeWhile (\e -> not (isMember e aci.aci_params)) ro.ro_fun_args old_f_a_help = dropWhile (\e -> not (isMember e aci.aci_params)) ro.ro_fun_args old_f_a_after = dropWhile (\e -> isMember e aci.aci_params) old_f_a_help - f_a_before` = [Var {var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr} \\ {fv_name,fv_info_ptr} <- f_a_before] - f_a_after` = [Var {var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr} \\ {fv_name,fv_info_ptr} <- f_a_after] + f_a_before` = [Var {var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr} \\ {fv_ident,fv_info_ptr} <- f_a_before] + f_a_after` = [Var {var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr} \\ {fv_ident,fv_info_ptr} <- f_a_after] (Yes aci) = opt_aci isMember x [hd:tl] = hd.fv_info_ptr==x.fv_info_ptr || isMember x tl @@ -479,8 +479,8 @@ transCase is_active opt_aci this_case=:{case_expr = case_expr=:(App app=:{app_sy | not (equal app_symb.symb_kind unfolder.symb_kind) // in this case a third function could be fused in -> possiblyFoldOuterCase this_case ro ti -!-> ("transCase","Diff opt unfolder",unfolder,app_symb) - # variables = [ Var {var_name=fv_name, var_info_ptr=fv_info_ptr, var_expr_ptr=nilPtr} - \\ {fv_name, fv_info_ptr} <- ro.ro_fun_args ] + # variables = [ Var {var_ident=fv_ident, var_info_ptr=fv_info_ptr, var_expr_ptr=nilPtr} + \\ {fv_ident, fv_info_ptr} <- ro.ro_fun_args ] (ti_next_fun_nr, ti) = ti!ti_next_fun_nr -!-> ("transCase","Yes opt unfolder",unfolder) (new_next_fun_nr, app_symb) = case ro.ro_root_case_mode of @@ -521,8 +521,8 @@ where old_f_a_before = takeWhile (\e -> not (isMember e aci.aci_params)) ro.ro_fun_args old_f_a_help = dropWhile (\e -> not (isMember e aci.aci_params)) ro.ro_fun_args old_f_a_after = dropWhile (\e -> isMember e aci.aci_params) old_f_a_help - f_a_before` = [Var {var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr} \\ {fv_name,fv_info_ptr} <- f_a_before] - f_a_after` = [Var {var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr} \\ {fv_name,fv_info_ptr} <- f_a_after] + f_a_before` = [Var {var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr} \\ {fv_ident,fv_info_ptr} <- f_a_before] + f_a_after` = [Var {var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr} \\ {fv_ident,fv_info_ptr} <- f_a_after] (Yes aci) = opt_aci isMember x [hd:tl] = hd.fv_info_ptr==x.fv_info_ptr || isMember x tl @@ -735,7 +735,7 @@ where where never_ident = case ro.ro_root_case_mode of NotRootCase -> case_ident - _ -> Yes ro.ro_fun_case.symb_name + _ -> Yes ro.ro_fun_case.symb_ident transCase is_active opt_aci this_case=:{case_expr = (BasicExpr basic_value),case_guards,case_default} ro ti | not is_active @@ -749,7 +749,7 @@ transCase is_active opt_aci this_case=:{case_expr = (BasicExpr basic_value),case with never_ident = case ro.ro_root_case_mode of NotRootCase -> this_case.case_ident - _ -> Yes ro.ro_fun_case.symb_name + _ -> Yes ro.ro_fun_case.symb_ident = transform (hd may_be_match_pattern).bp_expr { ro & ro_root_case_mode = NotRootCase } ti where getBasicPatterns (BasicPatterns _ basicPatterns) @@ -817,7 +817,7 @@ possibly_add_let non_unfoldable_args ap_expr not_unfoldable cons_type_args ro ti ) possibly_generate_case_function :: !Case !ActiveCaseInfo !ReadOnlyTI !*TransformInfo -> *(!Expression, !*TransformInfo) possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti=:{ti_recursion_introduced=old_ti_recursion_introduced} -// | False -!-> ("possibly_generate_case_function",ro.ro_fun_root.symb_name.id_name,ro.ro_fun_case.symb_name.id_name,ro.ro_root_case_mode) +// | False -!-> ("possibly_generate_case_function",ro.ro_fun_root.symb_ident.id_name,ro.ro_fun_case.symb_ident.id_name,ro.ro_root_case_mode) // = undef | not aci.aci_safe = skip_over kees ro ti @@ -845,23 +845,23 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti arguments_from_outer_fun = [ outer_argument \\ outer_argument<-outer_arguments & used<-used_mask | used ] lifted_arguments - = [ { fv_def_level = undeff, fv_name = var_name, fv_info_ptr = var_info_ptr, fv_count = undeff} - \\ {var_name, var_info_ptr} <- free_vars | not (isMember var_info_ptr outer_info_ptrs)] + = [ { fv_def_level = undeff, fv_ident = var_ident, fv_info_ptr = var_info_ptr, fv_count = undeff} + \\ {var_ident, var_info_ptr} <- free_vars | not (isMember var_info_ptr outer_info_ptrs)] all_args = lifted_arguments++arguments_from_outer_fun | SwitchArityChecks (length all_args > 32) False # ti = { ti & ti_cons_args = ti_cons_args, ti_fun_defs = ti_fun_defs, ti_fun_heap = ti_fun_heap, ti_recursion_introduced = No } | ro.ro_transform_fusion - # ti = { ti & ti_error_file = ti.ti_error_file <<< "Possibly missed fusion oppurtunity: Case Arity > 32 " <<< ro.ro_fun_root.symb_name.id_name <<< "\n"} + # ti = { ti & ti_error_file = ti.ti_error_file <<< "Possibly missed fusion oppurtunity: Case Arity > 32 " <<< ro.ro_fun_root.symb_ident.id_name <<< "\n"} = skip_over kees ro ti = skip_over kees ro ti # (fun_info_ptr, ti_fun_heap) = newPtr FI_Empty ti_fun_heap fun_ident - = { id_name = ro.ro_fun_root.symb_name.id_name+++"_case", id_info = nilPtr } - fun_symb - = { symb_name = fun_ident, symb_kind=SK_GeneratedFunction fun_info_ptr undeff } + = { id_name = ro.ro_fun_root.symb_ident.id_name+++"_case", id_info = nilPtr } + fun_ident + = { symb_ident = fun_ident, symb_kind=SK_GeneratedFunction fun_info_ptr undeff } <-!- ("<<<transformCaseFunction",fun_ident) | SwitchAlwaysIntroduceCaseFunction True False # ti @@ -871,10 +871,10 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti # ti = { ti & ti_next_fun_nr = fun_index + 1 } # new_ro - = { ro & ro_root_case_mode = RootCaseOfZombie , ro_fun_case = fun_symb, ro_fun_args = all_args } + = { ro & ro_root_case_mode = RootCaseOfZombie , ro_fun_case = fun_ident, ro_fun_args = all_args } = generate_case_function fun_index case_info_ptr (Case kees) outer_fun_def outer_cons_args used_mask new_ro ti # new_ro - = { ro & ro_root_case_mode = RootCaseOfZombie , ro_fun_case = fun_symb, ro_fun_args = all_args, ro_fun_geni = (-1,-1) } + = { ro & ro_root_case_mode = RootCaseOfZombie , ro_fun_case = fun_ident, ro_fun_args = all_args, ro_fun_geni = (-1,-1) } ti = { ti & ti_cons_args = ti_cons_args, ti_fun_defs = ti_fun_defs, ti_fun_heap = ti_fun_heap, ti_recursion_introduced = No } (new_expr, ti) @@ -891,9 +891,9 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti generate_case_function :: !Int !ExprInfoPtr !Expression FunDef .ConsClasses [.Bool] !.ReadOnlyTI !*TransformInfo -> (!Expression,!*TransformInfo) generate_case_function fun_index case_info_ptr new_expr outer_fun_def outer_cons_args used_mask {ro_fun_case=ro_fun=:{symb_kind=SK_GeneratedFunction fun_info_ptr _}, ro_fun_args} ti -// | False -!-> ("generate_case_function",ro_fun.symb_name) = undef +// | False -!-> ("generate_case_function",ro_fun.symb_ident) = undef # fun_arity = length ro_fun_args - # ti = arity_warning "generate_case_function" ro_fun.symb_name fun_index fun_arity ti + # ti = arity_warning "generate_case_function" ro_fun.symb_ident fun_index fun_arity ti (Yes {st_vars,st_args,st_attr_env}) = outer_fun_def.fun_type types_from_outer_fun = [ st_arg \\ st_arg <- st_args & used <- used_mask | used ] nr_of_lifted_vars = fun_arity-(length types_from_outer_fun) @@ -921,7 +921,7 @@ generate_case_function fun_index case_info_ptr new_expr outer_fun_def outer_cons {us_var_heap=ti_var_heap, us_symbol_heap=ti_symbol_heap, us_cleanup_info=ti_cleanup_info, us_opt_type_heaps = Yes ti_type_heaps} = us // generated function... - fun_def = { fun_symb = ro_fun.symb_name + fun_def = { fun_ident = ro_fun.symb_ident , fun_arity = fun_arity , fun_priority = NoPrio , fun_body = TransformedBody { tb_args = form_vars, tb_rhs = copied_expr} @@ -970,8 +970,8 @@ where get_type_of_local_var {fv_info_ptr} var_heap # (EVI_VarType a_type, var_heap) = readExtendedVarInfo fv_info_ptr var_heap = (a_type, var_heap) - free_var_to_bound_var {fv_name, fv_info_ptr} - = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr} + free_var_to_bound_var {fv_ident, fv_info_ptr} + = Var { var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr} determine_case_function_type fun_arity ct_result_type arg_types st_attr_env ti # {ti_type_heaps} = ti {th_vars} = ti_type_heaps @@ -1052,7 +1052,7 @@ where = is_never_matching_case expr never_ident = case ro.ro_root_case_mode of NotRootCase -> kees.case_ident - _ -> Yes ro.ro_fun_case.symb_name + _ -> Yes ro.ro_fun_case.symb_ident removeNeverMatchingSubcases expr ro = expr @@ -1201,12 +1201,12 @@ where create_fresh_type_vars :: !Int !*TypeVarHeap -> (!{!TypeVar}, !*TypeVarHeap) create_fresh_type_vars nr_of_all_type_vars th_vars - # fresh_array = createArray nr_of_all_type_vars {tv_name = {id_name="",id_info=nilPtr}, tv_info_ptr=nilPtr} + # fresh_array = createArray nr_of_all_type_vars {tv_ident = {id_name="",id_info=nilPtr}, tv_info_ptr=nilPtr} = iFoldSt allocate_fresh_type_var 0 nr_of_all_type_vars (fresh_array,th_vars) where allocate_fresh_type_var i (array, th_vars) # (new_tv_info_ptr, th_vars) = newPtr TVI_Empty th_vars - tv = { tv_name = { id_name = "a"+++toString i, id_info = nilPtr }, tv_info_ptr=new_tv_info_ptr } + tv = { tv_ident = { id_name = "a"+++toString i, id_info = nilPtr }, tv_info_ptr=new_tv_info_ptr } = ({array & [i] = tv}, th_vars) create_fresh_attr_vars :: !{!CoercionTree} !Int !*AttrVarHeap -> (!{!TypeAttribute}, !.AttrVarHeap) @@ -1222,7 +1222,7 @@ where -> ({ attr_var_array & [i] = TA_Multi}, th_attrs) _ # (new_info_ptr, th_attrs) = newPtr AVI_Empty th_attrs - -> ({ attr_var_array & [i] = TA_Var { av_name = NewAttrVarId i, av_info_ptr = new_info_ptr }}, th_attrs) + -> ({ attr_var_array & [i] = TA_Var { av_ident = NewAttrVarId i, av_info_ptr = new_info_ptr }}, th_attrs) coercionsToAttrEnv :: !{!TypeAttribute} !Coercions -> [AttrInequality] coercionsToAttrEnv attr_vars {coer_demanded, coer_offered} @@ -1293,9 +1293,9 @@ generateFunction app_symb fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_i cc_args cc_linear_bits prods fun_def_ptr ro n_extra ti=:{ti_var_heap,ti_next_fun_nr,ti_new_functions,ti_fun_heap,ti_symbol_heap,ti_fun_defs, ti_type_heaps,ti_cons_args,ti_cleanup_info, ti_type_def_infos} -// | False--->("generating new function",fd.fun_symb.id_name,"->",ti_next_fun_nr,prods,tb_args) = undef +// | False--->("generating new function",fd.fun_ident.id_name,"->",ti_next_fun_nr,prods,tb_args) = undef /* - | False-!->("generating new function",fd.fun_symb.id_name,"->",ti_next_fun_nr) = undef + | False-!->("generating new function",fd.fun_ident.id_name,"->",ti_next_fun_nr) = undef | False-!->("with type",fd.fun_type) = undef | False-!->("producers:",II_Node prods nilPtr II_Empty II_Empty,("cc_args",cc_args,("cc_linear_bits",cc_linear_bits))) = undef | False-!->("body:",tb_args, tb_rhs) = undef @@ -1407,7 +1407,7 @@ generateFunction app_symb fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_i , ti_fun_heap = ti_fun_heap, ti_var_heap = ti_var_heap, ti_cons_args = ti_cons_args, ti_type_def_infos = ti_type_def_infos , ti_predef_symbols = ti_predef_symbols } | ro.ro_transform_fusion - # ti = { ti & ti_error_file = ti.ti_error_file <<< "Possibly missed fusion oppurtunity: Function Arity > 32 " <<< ro.ro_fun_root.symb_name.id_name <<< "\n"} + # ti = { ti & ti_error_file = ti.ti_error_file <<< "Possibly missed fusion oppurtunity: Function Arity > 32 " <<< ro.ro_fun_root.symb_ident.id_name <<< "\n"} = (-1,new_fun_arity,ti) = (-1,new_fun_arity,ti) # new_arg_types = flatten [ ats_types \\ {ats_types}<-:new_arg_types_array ] @@ -1547,7 +1547,7 @@ generateFunction app_symb fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_i store_arg_type_info {fv_info_ptr} a_type ti_var_heap = setExtendedVarInfo fv_info_ptr (EVI_VarType a_type) ti_var_heap //*/ - # ro_fun= { symb_name = fd.fun_symb, symb_kind = SK_GeneratedFunction fun_def_ptr ti_next_fun_nr } + # ro_fun= { symb_ident = fd.fun_ident, symb_kind = SK_GeneratedFunction fun_def_ptr ti_next_fun_nr } # ro_root_case_mode = case tb_rhs of Case _ -> RootCase @@ -1636,15 +1636,15 @@ generateFunction app_symb fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_i ti_type_heaps = ti_type_heaps, ti_cleanup_info = us_cleanup_info, ti_cons_args = ti_cons_args, ti_predef_symbols = ti_predef_symbols } - # ti = arity_warning "generateFunction" fd.fun_symb.id_name ti_next_fun_nr new_fun_arity ti + # ti = arity_warning "generateFunction" fd.fun_ident.id_name ti_next_fun_nr new_fun_arity ti # (tb_rhs,ti) = case n_extra of 0 -> (tb_rhs,ti) _ # act_args = map f2b (reverse (take n_extra (reverse new_fun_args))) with - f2b { fv_name, fv_info_ptr } - = Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr } + f2b { fv_ident, fv_info_ptr } + = Var { var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr } -> add_args_to_fun_body act_args fresh_result_type tb_rhs ro ti (new_fun_rhs, ti) @@ -1865,10 +1865,10 @@ determine_args _ [] prod_index producers prod_atypes forms _ das=:{das_var_heap} where new_variables [] var_heap = ([], var_heap) - new_variables [form=:{fv_name,fv_info_ptr}:forms] var_heap + new_variables [form=:{fv_ident,fv_info_ptr}:forms] var_heap # (vars, var_heap) = new_variables forms var_heap (new_info_ptr, var_heap) = newPtr VI_Empty var_heap - = ([{ form & fv_info_ptr = new_info_ptr } : vars], writeVarInfo fv_info_ptr (VI_Variable fv_name new_info_ptr) var_heap) + = ([{ form & fv_info_ptr = new_info_ptr } : vars], writeVarInfo fv_info_ptr (VI_Variable fv_ident new_info_ptr) var_heap) determine_args [linear_bit : linear_bits] [cons_arg : cons_args] prod_index producers [prod_atype:prod_atypes] [form : forms] input das @@ -1885,9 +1885,9 @@ determine_arg :: !Producer .(Optional SymbolType) !FreeVar .Int !(!(!Bool,!ConsClass),!ReadOnlyTI) !*DetermineArgsState -> *DetermineArgsState -determine_arg PR_Empty _ form=:{fv_name,fv_info_ptr} _ ((linear_bit,cons_arg), _) das=:{das_var_heap} +determine_arg PR_Empty _ form=:{fv_ident,fv_info_ptr} _ ((linear_bit,cons_arg), _) das=:{das_var_heap} # (new_info_ptr, das_var_heap) = newPtr VI_Empty das_var_heap - # das_var_heap = writeVarInfo fv_info_ptr (VI_Variable fv_name new_info_ptr) das_var_heap + # das_var_heap = writeVarInfo fv_info_ptr (VI_Variable fv_ident new_info_ptr) das_var_heap = { das & das_vars = [{ form & fv_info_ptr = new_info_ptr } : das.das_vars ] , das_new_linear_bits = [ linear_bit : das.das_new_linear_bits ] @@ -1895,13 +1895,13 @@ determine_arg PR_Empty _ form=:{fv_name,fv_info_ptr} _ ((linear_bit,cons_arg), _ , das_var_heap = das_var_heap } -determine_arg PR_Unused _ form=:{fv_name,fv_info_ptr} prod_index (_,ro) das=:{das_var_heap} +determine_arg PR_Unused _ form=:{fv_ident,fv_info_ptr} prod_index (_,ro) das=:{das_var_heap} # no_arg_type = { ats_types= [], ats_strictness = NotStrict } = { das & das_arg_types.[prod_index] = no_arg_type } -determine_arg (PR_Class class_app free_vars_and_types class_type) _ {fv_info_ptr,fv_name} prod_index (_,ro) +determine_arg (PR_Class class_app free_vars_and_types class_type) _ {fv_info_ptr,fv_ident} prod_index (_,ro) das=:{das_arg_types, das_subst, das_type_heaps, das_predef} # (ws_arg_type, das_arg_types) = das_arg_types![prod_index] @@ -1928,10 +1928,10 @@ determine_arg (PR_Class class_app free_vars_and_types class_type) _ {fv_info_ptr | type_symb1 == type_symb2 = unify class_atype arg_type // FIXME: check indexes, not names. Need predefs for that. -// | type_symb1.type_name.id_name == "GenericDict" +// | type_symb1.type_ident.id_name == "GenericDict" | type_symb1.type_index == genericGlobalIndex = unify {class_atype & at_type = TA type_symb2 args1} arg_type -// | type_symb2.type_name.id_name == "GenericDict" +// | type_symb2.type_ident.id_name == "GenericDict" | type_symb2.type_index == genericGlobalIndex = unify class_atype {arg_type & at_type = TA type_symb1 args2} unify_dict class_atype arg_type @@ -1948,8 +1948,8 @@ determine_arg (PR_Class class_app free_vars_and_types class_type) _ {fv_info_ptr # ws_arg_type` = {ats_types= ws_ats_types, ats_strictness = first_n_strict (length free_vars_and_types) } = {das - & das_vars = mapAppend (\({var_info_ptr,var_name}, _) - -> { fv_name = var_name, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel, fv_count = 0 }) + & das_vars = mapAppend (\({var_info_ptr,var_ident}, _) + -> { fv_ident = var_ident, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel, fv_count = 0 }) free_vars_and_types das.das_vars , das_arg_types = {das_arg_types & [prod_index] = ws_arg_type` } , das_new_linear_bits = mapAppend (\_ -> True) free_vars_and_types das.das_new_linear_bits @@ -1961,7 +1961,7 @@ determine_arg (PR_Class class_app free_vars_and_types class_type) _ {fv_info_ptr } determine_arg producer (Yes {st_args, st_args_strictness, st_result, st_attr_vars, st_context, st_attr_env, st_arity}) - {fv_info_ptr,fv_name} prod_index ((linear_bit, _),ro) + {fv_info_ptr,fv_ident} prod_index ((linear_bit, _),ro) das=:{das_subst,das_type_heaps,das_fun_defs,das_fun_heap,das_var_heap,das_cons_args,das_arg_types,das_next_attr_nr} # {th_vars, th_attrs} = das_type_heaps @@ -2014,7 +2014,7 @@ determine_arg producer (Yes {st_args, st_args_strictness, st_result, st_attr_var = get_fun_def symbol.symb_kind ro.ro_main_dcl_module_n das_fun_defs das_fun_heap -> case fun_body of (TransformedBody tb) - -> (NoBody, take nr_of_applied_args [ fv_name \\ {fv_name}<-tb.tb_args ], das_fun_defs, das_fun_heap) + -> (NoBody, take nr_of_applied_args [ fv_ident \\ {fv_ident}<-tb.tb_args ], das_fun_defs, das_fun_heap) _ -> (NoBody, repeatn arity { id_name = "_x", id_info = nilPtr }, das_fun_defs, das_fun_heap) _ @@ -2022,7 +2022,7 @@ determine_arg producer (Yes {st_args, st_args_strictness, st_result, st_attr_var = get_fun_def symbol.symb_kind ro.ro_main_dcl_module_n das_fun_defs das_fun_heap -> case fun_body of (TransformedBody tb) - -> (fun_body, take nr_of_applied_args [ fv_name \\ {fv_name}<-tb.tb_args ], das_fun_defs, das_fun_heap) + -> (fun_body, take nr_of_applied_args [ fv_ident \\ {fv_ident}<-tb.tb_args ], das_fun_defs, das_fun_heap) _ -> abort ("determine_args:not a Transformed Body:"--->("producer",producer)) (form_vars, act_vars, das_var_heap) @@ -2041,8 +2041,8 @@ determine_arg producer (Yes {st_args, st_args_strictness, st_result, st_attr_var = case arg_type.at_annotation of AN_Strict # (new_info_ptr_l, das_var_heap) = newPtr VI_Empty das_var_heap - # free_var_l = { fv_name = { id_name = "free_l", id_info = nilPtr }, fv_info_ptr = new_info_ptr_l, fv_count = 0, fv_def_level = NotALevel } - # act_var_l = Var { var_name = { id_name = "act_l", id_info = nilPtr }, var_info_ptr = new_info_ptr_l, var_expr_ptr = nilPtr } + # free_var_l = { fv_ident = { id_name = "free_l", id_info = nilPtr }, fv_info_ptr = new_info_ptr_l, fv_count = 0, fv_def_level = NotALevel } + # act_var_l = Var { var_ident = { id_name = "act_l", id_info = nilPtr }, var_info_ptr = new_info_ptr_l, var_expr_ptr = nilPtr } # bind = {lb_dst = fv, lb_src = act_var_l, lb_position = NoPos} @@ -2073,8 +2073,8 @@ where = (form_vars, act_vars, var_heap) build_var_args [new_name:new_names] form_vars act_vars var_heap # (info_ptr, var_heap) = newPtr VI_Empty var_heap - form_var = { fv_name = new_name, fv_info_ptr = info_ptr, fv_count = 0, fv_def_level = NotALevel } - act_var = { var_name = new_name, var_info_ptr = info_ptr, var_expr_ptr = nilPtr } + form_var = { fv_ident = new_name, fv_info_ptr = info_ptr, fv_count = 0, fv_def_level = NotALevel } + act_var = { var_ident = new_name, var_info_ptr = info_ptr, var_expr_ptr = nilPtr } = build_var_args new_names [form_var : form_vars] [Var act_var : act_vars] var_heap calc_cons_args curried {symb_kind} symbol_arity ti_cons_args linear_bit size_fun_defs fun_heap @@ -2218,7 +2218,7 @@ where freshAttrVar attr_var th_attrs # (new_info_ptr, th_attrs) = newPtr AVI_Empty th_attrs - = ({ av_name = NewAttrVarId attr_var, av_info_ptr = new_info_ptr }, th_attrs) + = ({ av_ident = NewAttrVarId attr_var, av_info_ptr = new_info_ptr }, th_attrs) //@ max_group_index @@ -2263,7 +2263,7 @@ where = abort ("trans.icl: max_group_index_of_producer" ---> prod) max_group_index_of_member - (App {app_symb = {symb_name, symb_kind = SK_Function { glob_object = fun_index, glob_module = mod_index}}}) + (App {app_symb = {symb_ident, symb_kind = SK_Function { glob_object = fun_index, glob_module = mod_index}}}) (current_max, cons_args, fun_defs, fun_heap) | mod_index == ro_main_dcl_module_n # (size_args, cons_args) = usize cons_args @@ -2273,7 +2273,7 @@ where = (current_max, cons_args, fun_defs, fun_heap) = (current_max, cons_args, fun_defs, fun_heap) max_group_index_of_member - (App {app_symb = {symb_name, symb_kind = SK_LocalMacroFunction fun_index}}) + (App {app_symb = {symb_ident, symb_kind = SK_LocalMacroFunction fun_index}}) (current_max, cons_args, fun_defs, fun_heap) # (size_args, cons_args) = usize cons_args | fun_index < size_args @@ -2358,20 +2358,20 @@ instance replaceIntegers AType where // Variable binding... -bind_to_fresh_expr_var {fv_name, fv_info_ptr} var_heap +bind_to_fresh_expr_var {fv_ident, fv_info_ptr} var_heap # (new_info_ptr, var_heap) = newPtr VI_Empty var_heap - form_var = { fv_name = fv_name, fv_info_ptr = new_info_ptr, fv_count = undeff, fv_def_level = NotALevel } - act_var = { var_name = fv_name, var_info_ptr = new_info_ptr, var_expr_ptr = nilPtr } + form_var = { fv_ident = fv_ident, fv_info_ptr = new_info_ptr, fv_count = undeff, fv_def_level = NotALevel } + act_var = { var_ident = fv_ident, var_info_ptr = new_info_ptr, var_expr_ptr = nilPtr } = (form_var, writeVarInfo fv_info_ptr (VI_Expression (Var act_var)) var_heap) -bind_to_fresh_type_variable {tv_name, tv_info_ptr} th_vars +bind_to_fresh_type_variable {tv_ident, tv_info_ptr} th_vars # (new_tv_info_ptr, th_vars) = newPtr TVI_Empty th_vars - tv = { tv_name=tv_name, tv_info_ptr=new_tv_info_ptr } + tv = { tv_ident=tv_ident, tv_info_ptr=new_tv_info_ptr } = (tv, writePtr tv_info_ptr (TVI_Type (TV tv)) th_vars) -bind_to_fresh_attr_variable {av_name, av_info_ptr} th_attrs +bind_to_fresh_attr_variable {av_ident, av_info_ptr} th_attrs # (new_av_info_ptr, th_attrs) = newPtr AVI_Empty th_attrs - av = { av_name=av_name, av_info_ptr=new_av_info_ptr } + av = { av_ident=av_ident, av_info_ptr=new_av_info_ptr } = (av, writePtr av_info_ptr (AVI_Attr (TA_Var av)) th_attrs) bind_to_temp_type_var {tv_info_ptr} (next_type_var_nr, th_vars) @@ -2538,7 +2538,7 @@ where = ([], var_heap) # new_name = { id_name = "_a", id_info = nilPtr } (info_ptr, var_heap) = newPtr VI_Empty var_heap - form_var = { fv_name = new_name, fv_info_ptr = info_ptr, fv_count = 0, fv_def_level = NotALevel } + form_var = { fv_ident = new_name, fv_info_ptr = info_ptr, fv_count = 0, fv_def_level = NotALevel } (form_vars,var_heap) = create_new_args (n_new_args-1) var_heap = ([form_var : form_vars],var_heap) @@ -2809,13 +2809,13 @@ transformApplication app=:{app_symb=symb=:{symb_kind}, app_args} extra_args = (App { app & app_args = app_args ++ extra_args}, ti) | glob_module==ro.ro_stdStrictLists_module_n && is_cons_or_decons_of_UList_or_UTSList glob_object glob_module ro.ro_imported_funs && (not (isEmpty app_args)) -// && True ---> ("transformApplication "+++toString symb.symb_name) +// && True ---> ("transformApplication "+++toString symb.symb_ident) # {ft_type} = ro.ro_imported_funs.[glob_module].[glob_object] // type of cons instance of instance List [#] a | U(TS)List a # [{tc_class=TCClass {glob_module,glob_object={ds_index}}}:_] = ft_type.st_context - # member_n=find_member_n 0 symb.symb_name.id_name ro.ro_common_defs.[glob_module].com_class_defs.[ds_index].class_members + # member_n=find_member_n 0 symb.symb_ident.id_name ro.ro_common_defs.[glob_module].com_class_defs.[ds_index].class_members # cons_u_member_index=ro.ro_common_defs.[glob_module].com_class_defs.[ds_index].class_members.[member_n].ds_index - # {me_symb,me_offset}=ro.ro_common_defs.[glob_module].com_member_defs.[cons_u_member_index] - # select_symb= {glob_module=glob_module,glob_object={ds_ident=me_symb,ds_index=cons_u_member_index,ds_arity=1}} + # {me_ident,me_offset}=ro.ro_common_defs.[glob_module].com_member_defs.[cons_u_member_index] + # select_symb= {glob_module=glob_module,glob_object={ds_ident=me_ident,ds_index=cons_u_member_index,ds_arity=1}} # [first_arg:other_app_args] = app_args; # args=other_app_args++extra_args | isEmpty args @@ -2896,7 +2896,7 @@ transformApplication app=:{app_symb=symb=:{symb_kind}, app_args} extra_args = (Selection NormalSelector exp [RecordSelection select_symb me_offset],ti) // XXX linear_bits field has to be added for generated functions -transformApplication app=:{app_symb={symb_name,symb_kind = SK_GeneratedFunction fun_def_ptr fun_index}} extra_args +transformApplication app=:{app_symb={symb_ident,symb_kind = SK_GeneratedFunction fun_def_ptr fun_index}} extra_args ro ti=:{ti_cons_args,ti_instances,ti_fun_defs,ti_fun_heap} | fun_index < size ti_cons_args # (cons_class, ti_cons_args) = ti_cons_args![fun_index] @@ -2909,7 +2909,7 @@ transformApplication app=:{app_symb={symb_name,symb_kind = SK_GeneratedFunction = transformFunctionApplication gf_fun_def gf_instance_info gf_cons_args app extra_args ro ti transformApplication app [] ro ti = (App app, ti) -transformApplication app=:{app_symb={symb_name,symb_kind = SK_Constructor cons_index},app_args} extra_args +transformApplication app=:{app_symb={symb_ident,symb_kind = SK_Constructor cons_index},app_args} extra_args ro ti=:{ti_cons_args,ti_instances,ti_fun_defs,ti_fun_heap} # {cons_type} = ro.ro_common_defs.[cons_index.glob_module].com_cons_defs.[cons_index.glob_object] # (app_args,extra_args) = complete_application cons_type.st_arity app_args extra_args @@ -2959,7 +2959,7 @@ where _ -> False = cnf_args args (inc index) strictness ro - cnf_app_args {app_symb=symb=:{symb_kind = SK_Constructor cons_index, symb_name}, app_args} ro + cnf_app_args {app_symb=symb=:{symb_kind = SK_Constructor cons_index, symb_ident}, app_args} ro # {cons_type} = ro.ro_common_defs.[cons_index.glob_module].com_cons_defs.[cons_index.glob_object] = cnf_args app_args 0 cons_type.st_args_strictness ro cnf_app_args {app_symb=symb=:{symb_kind}, app_args} ro @@ -3016,7 +3016,7 @@ determineProducers is_applied_to_macro_fun consumer_is_curried ok_non_rec_consum _ # (info_ptr, ti_var_heap) = newPtr VI_Empty ti.ti_var_heap ti = {ti & ti_var_heap = ti_var_heap} lb = {lb_dst= - { fv_name = { id_name = "dummy_for_strict_unused", id_info = nilPtr } + { fv_ident = { id_name = "dummy_for_strict_unused", id_info = nilPtr } , fv_info_ptr = info_ptr , fv_count = 0 , fv_def_level = NotALevel @@ -3077,10 +3077,10 @@ determineProducer _ _ _ _ app=:{app_symb = symb=:{symb_kind = SK_Constructor _}, , { ti & ti_var_heap = ti_var_heap } ) -determineProducer _ _ _ linear_bit app=:{app_symb = symb=:{symb_kind = SK_Constructor cons_index, symb_name}, app_args} _ +determineProducer _ _ _ linear_bit app=:{app_symb = symb=:{symb_kind = SK_Constructor cons_index, symb_ident}, app_args} _ new_args prod_index producers ro ti # {cons_type} = ro.ro_common_defs.[cons_index.glob_module].com_cons_defs.[cons_index.glob_object] - rnf = rnf_args app_args 0 cons_type.st_args_strictness ro //---> ("rnf_args",symb_name) + rnf = rnf_args app_args 0 cons_type.st_args_strictness ro //---> ("rnf_args",symb_ident) | SwitchConstructorFusion (ro.ro_transform_fusion && SwitchRnfConstructorFusion (linear_bit || rnf) linear_bit) False @@ -3097,9 +3097,9 @@ where _ -> False //---> ("rnf_arg","Other") = rnf_args args (inc index) strictness ro //---> ("rnf_arg","Lazy") - rnf_app_args {app_symb=symb=:{symb_kind = SK_Constructor cons_index, symb_name}, app_args} args index strictness ro + rnf_app_args {app_symb=symb=:{symb_kind = SK_Constructor cons_index, symb_ident}, app_args} args index strictness ro # {cons_type} = ro.ro_common_defs.[cons_index.glob_module].com_cons_defs.[cons_index.glob_object] - | rnf_args app_args 0 cons_type.st_args_strictness ro //---> ("rnf_args",symb_name) + | rnf_args app_args 0 cons_type.st_args_strictness ro //---> ("rnf_args",symb_ident) = rnf_args args (inc index) strictness ro = False // what else is rnf => curried apps @@ -3115,10 +3115,10 @@ determineProducer is_applied_to_macro_fun consumer_is_curried ok_non_rec_consume | length app_args<>fun_arity | is_applied_to_macro_fun = ({ producers & [prod_index] = PR_Curried symb (length app_args)}, app_args ++ new_args, ti) - -!-> ("Produce1cc_macro",symb.symb_name) + -!-> ("Produce1cc_macro",symb.symb_ident) | SwitchCurriedFusion ro.ro_transform_fusion cc_producer False = ({ producers & [prod_index] = PR_Curried symb (length app_args)}, app_args ++ new_args, ti) - -!-> ("Produce1cc_curried",symb.symb_name) + -!-> ("Produce1cc_curried",symb.symb_ident) = (producers, [App app : new_args ], ti) # is_good_producer = case fun_body of @@ -3128,7 +3128,7 @@ determineProducer is_applied_to_macro_fun consumer_is_curried ok_non_rec_consume -> SwitchGeneratedFusion (ro.ro_transform_fusion && linear_bit && is_sexy_body tb_rhs) False | cc_producer && is_good_producer = ({ producers & [prod_index] = (PR_GeneratedFunction symb (length app_args) fun_index)}, app_args ++ new_args, ti) - -!-> ("Produce1cc",symb.symb_name) + -!-> ("Produce1cc",symb.symb_ident) # not_expanding_producer = case fun_body of Expanding _ @@ -3140,12 +3140,12 @@ determineProducer is_applied_to_macro_fun consumer_is_curried ok_non_rec_consume ((not consumer_is_curried && not_expanding_producer) && is_applied_to_macro_fun && linear_bit && is_higher_order_function fun_type) False = ({ producers & [prod_index] = PR_Curried symb (length app_args)}, app_args ++ new_args, ti) - -!-> ("Produce1cc_ho",symb.symb_name) + -!-> ("Produce1cc_ho",symb.symb_ident) | SwitchHOFusion` ((not consumer_is_curried && not_expanding_producer) && ok_non_rec_consumer && linear_bit && is_higher_order_function fun_type) False = ({ producers & [prod_index] = PR_Curried symb (length app_args)}, app_args ++ new_args, ti) - -!-> ("Produce1cc_hnr",symb.symb_name) + -!-> ("Produce1cc_hnr",symb.symb_ident) // NON-REC... # non_rec_producer = (fun_info.fi_properties bitand FI_IsNonRecursive) <> 0 @@ -3157,10 +3157,10 @@ determineProducer is_applied_to_macro_fun consumer_is_curried ok_non_rec_consume -> ro.ro_transform_fusion && not_expanding_producer && is_sexy_body tb_rhs && ok_non_rec_consumer && non_rec_producer//is_good_producer | SwitchNonRecFusion ok_non_rec False = ({ producers & [prod_index] = (PR_GeneratedFunction symb (length app_args) fun_index)}, app_args ++ new_args, ti) - -!-> ("Produce1nr",symb.symb_name) + -!-> ("Produce1nr",symb.symb_ident) // ...NON-REC = (producers, [App app : new_args ], ti) - -!-> ("Produce1--",symb.symb_name) + -!-> ("Produce1--",symb.symb_ident) determineProducer is_applied_to_macro_fun consumer_is_curried ok_non_rec_consumer linear_bit app=:{app_symb = symb=:{symb_kind}, app_args} _ new_args prod_index producers ro ti @@ -3173,23 +3173,23 @@ determineProducer is_applied_to_macro_fun consumer_is_curried ok_non_rec_consume | length app_args<>fun_arity | is_applied_to_macro_fun = ({ producers & [prod_index] = PR_Curried symb (length app_args)}, app_args ++ new_args, ti) - -!-> ("Produce2cc_macro",symb.symb_name) + -!-> ("Produce2cc_macro",symb.symb_ident) # ({cc_producer},ti) = ti!ti_cons_args.[glob_object] | SwitchCurriedFusion ro.ro_transform_fusion cc_producer False = ({ producers & [prod_index] = PR_Curried symb (length app_args)}, app_args ++ new_args, ti) - -!-> ("Produce2cc_curried",symb.symb_name) + -!-> ("Produce2cc_curried",symb.symb_ident) = (producers, [App app : new_args ], ti) #! max_index = size ti.ti_cons_args | glob_module <> ro.ro_main_dcl_module_n || glob_object >= max_index /* Sjaak, to skip array functions */ = (producers, [App app : new_args ], ti) - -!-> ("Produce2cc_array",symb.symb_name,if (glob_module <> ro.ro_main_dcl_module_n) "foreign" "array") + -!-> ("Produce2cc_array",symb.symb_ident,if (glob_module <> ro.ro_main_dcl_module_n) "foreign" "array") # ({fun_body,fun_type,fun_info}, ti) = ti!ti_fun_defs.[glob_object] (TransformedBody {tb_rhs}) = fun_body is_good_producer = SwitchFunctionFusion (ro.ro_transform_fusion && linear_bit && is_sexy_body tb_rhs) False {cc_producer} = ti.ti_cons_args.[glob_object] | is_good_producer && cc_producer && not consumer_is_curried = ({ producers & [prod_index] = (PR_Function symb (length app_args) glob_object)}, app_args ++ new_args, ti) - -!-> ("Produce2cc",symb.symb_name) + -!-> ("Produce2cc",symb.symb_ident) # not_expanding_producer = case fun_body of Expanding _ @@ -3199,7 +3199,7 @@ determineProducer is_applied_to_macro_fun consumer_is_curried ok_non_rec_consume // -> cc_producer | (not consumer_is_curried && not_expanding_producer) && is_applied_to_macro_fun && linear_bit && is_higher_order_function fun_type = ({ producers & [prod_index] = PR_Curried symb (length app_args)}, app_args ++ new_args, ti) - -!-> ("Produce2cc_ho",symb.symb_name) + -!-> ("Produce2cc_ho",symb.symb_ident) // NON-REC... # non_rec_producer = (fun_info.fi_properties bitand FI_IsNonRecursive) <> 0 @@ -3211,12 +3211,12 @@ determineProducer is_applied_to_macro_fun consumer_is_curried ok_non_rec_consume -> ro.ro_transform_fusion && not_expanding_producer && is_sexy_body tb_rhs && ok_non_rec_consumer && non_rec_producer//&& is_good_producer | SwitchNonRecFusion ok_non_rec False = ({ producers & [prod_index] = (PR_Function symb (length app_args) glob_object)}, app_args ++ new_args, ti) - -!-> ("Produce2nr",symb.symb_name) + -!-> ("Produce2nr",symb.symb_ident) // ...NON-REC = (producers, [App app : new_args ], ti) - -!-> ("Produce2-1",symb.symb_name) + -!-> ("Produce2-1",symb.symb_ident) = (producers, [App app : new_args ], ti) - -!-> ("Produce2-2",symb.symb_name) + -!-> ("Produce2-2",symb.symb_ident) where get_max_index ti=:{ti_cons_args} #! (max_index, ti_cons_args) = usize ti_cons_args @@ -3270,7 +3270,7 @@ renewVariables exprs var_heap = (exprs, (new_vars, free_vars, var_heap)) where map_expr :: !Expression !RenewState -> (!Expression, !RenewState) - map_expr (Var var=:{var_info_ptr, var_name}) (new_vars_accu, free_vars_accu, var_heap) + map_expr (Var var=:{var_info_ptr, var_ident}) (new_vars_accu, free_vars_accu, var_heap) # (var_info, var_heap) = readPtr var_info_ptr var_heap = case var_info of @@ -3279,7 +3279,7 @@ renewVariables exprs var_heap , (new_vars_accu, free_vars_accu, var_heap)) VI_Extended evi=:(EVI_VarType var_type) _ # (new_var, var_heap) - = allocate_and_bind_new_var var_name var_info_ptr evi var_heap + = allocate_and_bind_new_var var_ident var_info_ptr evi var_heap -> ( Var new_var , ( [(new_var, var_type.at_type) : new_vars_accu] , [var:free_vars_accu] @@ -3290,20 +3290,20 @@ renewVariables exprs var_heap map_expr x st = (x, st) preprocess_local_var :: !FreeVar !RenewState -> (!FreeVar, !RenewState) - preprocess_local_var fv=:{fv_name, fv_info_ptr} (new_vars_accu, free_vars_accu, var_heap) + preprocess_local_var fv=:{fv_ident, fv_info_ptr} (new_vars_accu, free_vars_accu, var_heap) // # (VI_Extended evi _, var_heap) // = readPtr fv_info_ptr var_heap # (evi, var_heap) = readExtendedVarInfo fv_info_ptr var_heap (new_var, var_heap) - = allocate_and_bind_new_var fv_name fv_info_ptr evi var_heap + = allocate_and_bind_new_var fv_ident fv_info_ptr evi var_heap = ( { fv & fv_info_ptr = new_var.var_info_ptr } , (new_vars_accu, free_vars_accu, var_heap)) - allocate_and_bind_new_var var_name var_info_ptr evi var_heap + allocate_and_bind_new_var var_ident var_info_ptr evi var_heap # (new_info_ptr, var_heap) = newPtr (VI_Extended evi VI_Empty) var_heap new_var - = { var_name = var_name, var_info_ptr = new_info_ptr, var_expr_ptr = nilPtr } + = { var_ident = var_ident, var_info_ptr = new_info_ptr, var_expr_ptr = nilPtr } var_heap = writeVarInfo var_info_ptr (VI_Forward new_var) var_heap = (new_var, var_heap) @@ -3583,9 +3583,9 @@ where store_arg_type_info {fv_info_ptr} a_type ti_var_heap = setExtendedVarInfo fv_info_ptr (EVI_VarType a_type) ti_var_heap - fun_def_to_symb_ident fun_index fsize {fun_symb} + fun_def_to_symb_ident fun_index fsize {fun_ident} | fun_index < fsize - = { symb_name=fun_symb, symb_kind=SK_Function {glob_object=fun_index, glob_module=main_dcl_module_n } } + = { symb_ident=fun_ident, symb_kind=SK_Function {glob_object=fun_index, glob_module=main_dcl_module_n } } get_root_case_mode {tb_rhs=Case _} = RootCase get_root_case_mode _ = NotRootCase @@ -3593,7 +3593,7 @@ where get_fun_def_and_symb_ident fun ti=:{ti_fun_defs} | fun < size ti_fun_defs # (fun_def, ti) = ti!ti_fun_defs.[fun] - # si = { symb_name=fun_def.fun_symb, symb_kind=SK_Function {glob_object=fun, glob_module=main_dcl_module_n } } + # si = { symb_ident=fun_def.fun_ident, symb_kind=SK_Function {glob_object=fun, glob_module=main_dcl_module_n } } = (fun_def,si,ti) # (fun_def_ptr,ti_fun_heap) = lookup_ptr fun ti.ti_new_functions ti.ti_fun_heap with @@ -3606,7 +3606,7 @@ where = lookup_ptr fun new_functions ti_fun_heap # (FI_Function {gf_fun_def}, ti_fun_heap) = readPtr fun_def_ptr ti_fun_heap - # si = { symb_name=gf_fun_def.fun_symb, symb_kind=SK_GeneratedFunction fun_def_ptr fun } + # si = { symb_ident=gf_fun_def.fun_ident, symb_kind=SK_GeneratedFunction fun_def_ptr fun } ti = { ti & ti_fun_heap = ti_fun_heap } = (gf_fun_def,si,ti) @@ -3637,10 +3637,10 @@ where , prs_group_index = group_nr } # (safe,prs) = producerRequirements fun_body prs -// # prs = prs ---> ("producerRequirements",fun_def.fun_symb,fun,group_nr,safe,fun_body) +// # prs = prs ---> ("producerRequirements",fun_def.fun_ident,fun,group_nr,safe,fun_body) #! ti = {ti & ti_fun_defs = prs.prs_fun_defs, ti_fun_heap = prs.prs_fun_heap, ti_cons_args = prs.prs_cons_args} // put back prs info into ti? - | safe //-!-> ("producerRequirements",fun_def.fun_symb,safe) + | safe //-!-> ("producerRequirements",fun_def.fun_ident,safe) = safe_producers group_nr group_members funs ti = (safe,ti) @@ -3885,9 +3885,9 @@ where expand_syn_types_in_TA :: !.Int !{#.CommonDefs} !.Type !.TypeAttribute !*ExpandTypeState -> (!Bool,!Type,!.ExpandTypeState) expand_syn_types_in_TA rem_annots common_defs ta_type attribute ets=:{ets_type_defs} # (glob_object,glob_module,types) = case ta_type of - (TA type_symb=:{type_index={glob_object,glob_module},type_name} types) -> (glob_object,glob_module,types) - (TAS type_symb=:{type_index={glob_object,glob_module},type_name} types strictness) -> (glob_object,glob_module,types) - # ({td_rhs,td_name,td_args,td_attribute},ets_type_defs) = ets_type_defs![glob_module].[glob_object] + (TA type_symb=:{type_index={glob_object,glob_module},type_ident} types) -> (glob_object,glob_module,types) + (TAS type_symb=:{type_index={glob_object,glob_module},type_ident} types strictness) -> (glob_object,glob_module,types) + # ({td_rhs,td_ident,td_args,td_attribute},ets_type_defs) = ets_type_defs![glob_module].[glob_object] ets = { ets & ets_type_defs = ets_type_defs } = case td_rhs of SynType rhs_type @@ -4118,8 +4118,8 @@ where where adjust_var_info _ (VI_UsedVar _) fvi_variables fvi_var_heap = (fvi_variables, fvi_var_heap) - adjust_var_info bound_var=:{var_name} _ fvi_variables fvi_var_heap - = ([bound_var : fvi_variables], writeVarInfo var_info_ptr (VI_UsedVar var_name) fvi_var_heap) + adjust_var_info bound_var=:{var_ident} _ fvi_variables fvi_var_heap + = ([bound_var : fvi_variables], writeVarInfo var_info_ptr (VI_UsedVar var_ident) fvi_var_heap) instance freeVariables Expression where @@ -4219,7 +4219,7 @@ determineGlobalVariables global_variables var_heap where determine_global_variable {var_info_ptr} (global_variables, var_heap) # (VI_UsedVar v_name, var_heap) = readVarInfo var_info_ptr var_heap - = ([{var_name = v_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr} : global_variables], var_heap) + = ([{var_ident = v_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr} : global_variables], var_heap) removeLocalVariables local_variables all_variables global_variables var_heap # var_heap = foldSt mark_local_var local_variables var_heap @@ -4528,12 +4528,12 @@ where instance <<< Producer where (<<<) file (PR_Function symbol _ index) - = file <<< "(F)" <<< symbol.symb_name + = file <<< "(F)" <<< symbol.symb_ident (<<<) file (PR_GeneratedFunction symbol _ index) - = file <<< "(G)" <<< symbol.symb_name <<< index + = file <<< "(G)" <<< symbol.symb_ident <<< index (<<<) file PR_Empty = file <<< 'E' (<<<) file (PR_Class app vars type) = file <<< "(Class(" <<< App app<<<","<<< type <<< "))" - (<<<) file (PR_Curried {symb_name, symb_kind} _) = file <<< "(Curried)" <<< symb_name <<< symb_kind + (<<<) file (PR_Curried {symb_ident, symb_kind} _) = file <<< "(Curried)" <<< symb_ident <<< symb_kind (<<<) file _ = file */ @@ -4600,15 +4600,15 @@ where instance <<< SymbIdent where (<<<) file symb=:{symb_kind = SK_Function symb_index } - = file <<< symb.symb_name <<< '@' <<< symb_index + = file <<< symb.symb_ident <<< '@' <<< symb_index (<<<) file symb=:{symb_kind = SK_LocalMacroFunction symb_index } - = file <<< symb.symb_name <<< '@' <<< symb_index + = file <<< symb.symb_ident <<< '@' <<< symb_index (<<<) file symb=:{symb_kind = SK_GeneratedFunction _ symb_index } - = file <<< symb.symb_name <<< '@' <<< symb_index + = file <<< symb.symb_ident <<< '@' <<< symb_index (<<<) file symb=:{symb_kind = SK_OverloadedFunction symb_index } - = file <<< symb.symb_name <<< "[o]@" <<< symb_index + = file <<< symb.symb_ident <<< "[o]@" <<< symb_index (<<<) file symb - = file <<< symb.symb_name + = file <<< symb.symb_ident /* instance <<< {!Type} where @@ -4674,10 +4674,10 @@ foundSpecial _ = True // ...SPECIAL -arity_warning msg symb_name fun_index fun_arity ti +arity_warning msg symb_ident fun_index fun_arity ti | fun_arity <= 32 = ti - = {ti & ti_error_file = ti.ti_error_file <<< "Warning: Arity > 32 " <<< msg <<< " " <<< fun_arity <<< " " <<< symb_name <<< "@" <<< fun_index <<< "\n"} + = {ti & ti_error_file = ti.ti_error_file <<< "Warning: Arity > 32 " <<< msg <<< " " <<< fun_arity <<< " " <<< symb_ident <<< "@" <<< fun_index <<< "\n"} strip_universal_quantor :: SymbolType -> SymbolType strip_universal_quantor st=:{st_vars,st_args,st_result} diff --git a/frontend/transform.icl b/frontend/transform.icl index c7326c0..b999102 100644 --- a/frontend/transform.icl +++ b/frontend/transform.icl @@ -40,16 +40,16 @@ where instance lift Expression where - lift (FreeVar {fv_name,fv_info_ptr}) ls=:{ls_var_heap} + lift (FreeVar {fv_ident,fv_info_ptr}) ls=:{ls_var_heap} # (var_info, ls_var_heap) = readPtr fv_info_ptr ls_var_heap ls = { ls & ls_var_heap = ls_var_heap } = case var_info of VI_LiftedVariable var_info_ptr # (var_expr_ptr, ls_expr_heap) = newPtr EI_Empty ls.ls_expr_heap - -> (Var { var_name = fv_name, var_info_ptr = var_info_ptr, var_expr_ptr = var_expr_ptr }, { ls & ls_expr_heap = ls_expr_heap}) + -> (Var { var_ident = fv_ident, var_info_ptr = var_info_ptr, var_expr_ptr = var_expr_ptr }, { ls & ls_expr_heap = ls_expr_heap}) _ # (var_expr_ptr, ls_expr_heap) = newPtr EI_Empty ls.ls_expr_heap - -> (Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, { ls & ls_expr_heap = ls_expr_heap}) + -> (Var { var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, { ls & ls_expr_heap = ls_expr_heap}) lift (App app) ls # (app, ls) = lift app ls = (App app, ls) @@ -80,9 +80,9 @@ where lift (TupleSelect symbol argn_nr expr) ls # (expr, ls) = lift expr ls = (TupleSelect symbol argn_nr expr, ls) - lift (MatchExpr cons_symb expr) ls + lift (MatchExpr cons_ident expr) ls # (expr, ls) = lift expr ls - = (MatchExpr cons_symb expr, ls) + = (MatchExpr cons_ident expr, ls) lift (DynamicExpr expr) ls # (expr, ls) = lift expr ls = (DynamicExpr expr, ls) @@ -127,16 +127,16 @@ where add_free_variables_in_app :: ![FreeVar] ![Expression] !*VarHeap !*ExpressionHeap -> (![Expression],!*VarHeap,!*ExpressionHeap) add_free_variables_in_app [] app_args var_heap expr_heap = (app_args, var_heap, expr_heap) - add_free_variables_in_app [{fv_name, fv_info_ptr} : free_vars] app_args var_heap expr_heap + add_free_variables_in_app [{fv_ident, fv_info_ptr} : free_vars] app_args var_heap expr_heap # (var_info,var_heap) = readPtr fv_info_ptr var_heap = case var_info of VI_LiftedVariable var_info_ptr # (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap - -> add_free_variables_in_app free_vars [Var { var_name = fv_name, var_info_ptr = var_info_ptr, var_expr_ptr = var_expr_ptr } : app_args] + -> add_free_variables_in_app free_vars [Var { var_ident = fv_ident, var_info_ptr = var_info_ptr, var_expr_ptr = var_expr_ptr } : app_args] var_heap expr_heap _ # (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap - -> add_free_variables_in_app free_vars [Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr } : app_args] + -> add_free_variables_in_app free_vars [Var { var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr } : app_args] var_heap expr_heap instance lift LetBind @@ -305,7 +305,7 @@ where fun_defs = ls_x.x_fun_defs fun_defs = { fun_defs & [fun] = { fun_def & fun_lifted = fun_lifted, fun_body = PartitioningFunction {cb_args = cb_args, cb_rhs = cb_rhs} fun_number}} = {ls_x={ls_x & x_fun_defs=fun_defs}, ls_var_heap=ls_var_heap, ls_expr_heap= ls_expr_heap} -// ---> ("lift_function", fun_def.fun_symb, fi_free_vars, cb_args, cb_rhs) +// ---> ("lift_function", fun_def.fun_ident, fi_free_vars, cb_args, cb_rhs) lift_function (DclMacroIndex module_index fun) {ls_x=ls_x=:{x_macro_defs=macro_defs=:{[module_index,fun] = fun_def}}, ls_var_heap=var_heap, ls_expr_heap=expr_heap} # {fi_free_vars} = fun_def.fun_info fun_lifted = length fi_free_vars @@ -318,9 +318,9 @@ where = {ls_x={ls_x & x_macro_defs=macro_defs}, ls_var_heap=ls_var_heap, ls_expr_heap= ls_expr_heap} remove_lifted_args vars var_heap - = foldl (\var_heap {fv_name,fv_info_ptr} -> writePtr fv_info_ptr VI_Empty var_heap) var_heap vars + = foldl (\var_heap {fv_ident,fv_info_ptr} -> writePtr fv_info_ptr VI_Empty var_heap) var_heap vars - add_lifted_args [lifted_arg=:{fv_name,fv_info_ptr} : lifted_args] args var_heap + add_lifted_args [lifted_arg=:{fv_ident,fv_info_ptr} : lifted_args] args var_heap # (new_info_ptr, var_heap) = newPtr VI_Empty var_heap args = [{ lifted_arg & fv_info_ptr = new_info_ptr } : args ] = add_lifted_args lifted_args args (writePtr fv_info_ptr (VI_LiftedVariable new_info_ptr) var_heap) @@ -328,18 +328,18 @@ where = (args, var_heap) unfoldVariable :: !BoundVar UnfoldInfo !*UnfoldState -> (!Expression, !*UnfoldState) -unfoldVariable var=:{var_name,var_info_ptr} ui us +unfoldVariable var=:{var_ident,var_info_ptr} ui us # (var_info, us) = readVarInfo var_info_ptr us = case var_info of VI_Expression expr -> (expr, us) - VI_Variable var_name var_info_ptr + VI_Variable var_ident var_info_ptr # (var_expr_ptr, us_symbol_heap) = newPtr EI_Empty us.us_symbol_heap - -> (Var {var_name = var_name, var_info_ptr = var_info_ptr, var_expr_ptr = var_expr_ptr}, { us & us_symbol_heap = us_symbol_heap}) - VI_Body fun_symb _ vars - -> (App { app_symb = fun_symb, - app_args = [ Var { var_name=fv_name, var_info_ptr=fv_info_ptr, var_expr_ptr=nilPtr } - \\ {fv_name,fv_info_ptr}<-vars], + -> (Var {var_ident = var_ident, var_info_ptr = var_info_ptr, var_expr_ptr = var_expr_ptr}, { us & us_symbol_heap = us_symbol_heap}) + VI_Body fun_ident _ vars + -> (App { app_symb = fun_ident, + app_args = [ Var { var_ident=fv_ident, var_info_ptr=fv_info_ptr, var_expr_ptr=nilPtr } + \\ {fv_ident,fv_info_ptr}<-vars], app_info_ptr = nilPtr }, us) VI_Dictionary app_symb app_args class_type # (new_class_type, us_opt_type_heaps) = substitute_class_types class_type us.us_opt_type_heaps @@ -426,9 +426,9 @@ where unfold (TupleSelect symbol argn_nr expr) ui us # (expr, us) = unfold expr ui us = (TupleSelect symbol argn_nr expr, us) - unfold (MatchExpr cons_symb expr) ui us + unfold (MatchExpr cons_ident expr) ui us # (expr, us) = unfold expr ui us - = (MatchExpr cons_symb expr, us) + = (MatchExpr cons_ident expr, us) unfold (DynamicExpr expr) ui us # (expr, us) = unfold expr ui us = (DynamicExpr expr, us) @@ -454,8 +454,8 @@ where = case var_expr of App {app_symb={symb_kind= SK_Constructor _ }, app_args} # [RecordSelection _ field_index:_] = selectors - (App { app_symb = {symb_name, symb_kind = SK_Function array_select}}) = app_args !! field_index - -> (ArraySelection { array_select & glob_object = { ds_ident = symb_name, ds_arity = 2, ds_index = array_select.glob_object}} + (App { app_symb = {symb_ident, symb_kind = SK_Function array_select}}) = app_args !! field_index + -> (ArraySelection { array_select & glob_object = { ds_ident = symb_ident, ds_arity = 2, ds_index = array_select.glob_object}} new_ptr index_expr, us) Var var -> (DictionarySelection var selectors new_ptr index_expr, us) @@ -464,9 +464,9 @@ where instance unfold FreeVar where - unfold fv=:{fv_info_ptr,fv_name} ui us=:{us_var_heap} + unfold fv=:{fv_info_ptr,fv_ident} ui us=:{us_var_heap} # (new_info_ptr, us_var_heap) = newPtr VI_Empty us_var_heap - = ({ fv & fv_info_ptr = new_info_ptr }, { us & us_var_heap = writePtr fv_info_ptr (VI_Variable fv_name new_info_ptr) us_var_heap }) + = ({ fv & fv_info_ptr = new_info_ptr }, { us & us_var_heap = writePtr fv_info_ptr (VI_Variable fv_ident new_info_ptr) us_var_heap }) instance unfold App where unfold app=:{app_symb={symb_kind}, app_args, app_info_ptr} ui us @@ -594,13 +594,13 @@ where -> (Yes fvs_subst, us) (var_info, us) = readVarInfo var_info_ptr us -> case var_info of - VI_Body fun_symb {tb_args, tb_rhs} new_aci_params + VI_Body fun_ident {tb_args, tb_rhs} new_aci_params # tb_args_ptrs = [ fv_info_ptr \\ {fv_info_ptr}<-tb_args ] (original_bindings, us_var_heap) = mapSt readPtr tb_args_ptrs us.us_var_heap us_var_heap = fold2St bind tb_args_ptrs new_aci_params us_var_heap (tb_rhs, us) = unfold tb_rhs ui { us & us_var_heap = us_var_heap } us_var_heap = fold2St writePtr tb_args_ptrs original_bindings us.us_var_heap - new_aci = { aci & aci_params = new_aci_params, aci_opt_unfolder = Yes fun_symb, aci_free_vars = new_aci_free_vars } + new_aci = { aci & aci_params = new_aci_params, aci_opt_unfolder = Yes fun_ident, aci_free_vars = new_aci_free_vars } new_eei = (EI_Extended (EEI_ActiveCase new_aci) ei) us_symbol_heap = writePtr case_info_ptr new_eei us.us_symbol_heap -> (tb_rhs, { us & us_var_heap = us_var_heap, us_symbol_heap = us_symbol_heap }) @@ -610,8 +610,8 @@ where _ -> unfold case_expr ui us where // XXX consider to store BoundVars in VI_Body - bind fv_info_ptr {fv_name=name, fv_info_ptr=info_ptr} var_heap - = writeVarInfo fv_info_ptr (VI_Expression (Var {var_name=name, var_info_ptr=info_ptr, var_expr_ptr = nilPtr})) var_heap + bind fv_info_ptr {fv_ident=name, fv_info_ptr=info_ptr} var_heap + = writeVarInfo fv_info_ptr (VI_Expression (Var {var_ident=name, var_info_ptr=info_ptr, var_expr_ptr = nilPtr})) var_heap /* bind ({fv_info_ptr}, var_bound_var) var_heap = writeVarInfo fv_info_ptr (VI_Expression var_bound_var) var_heap @@ -620,10 +620,10 @@ where /* update_active_case_info_and_unfold case_expr=:(Var {var_info_ptr}) case_info_ptr us #! var_info = sreadPtr var_info_ptr us.us_var_heap = case var_info of - VI_Body fun_symb fun_body new_aci_var_info_ptr + VI_Body fun_ident fun_body new_aci_var_info_ptr # (fun_body, us) = unfold fun_body us (EI_Extended (EEI_ActiveCase aci) ei, us_symbol_heap) = readPtr case_info_ptr us.us_symbol_heap - new_aci = { aci & aci_var_info_ptr = new_aci_var_info_ptr, aci_opt_unfolder = Yes fun_symb } + new_aci = { aci & aci_var_info_ptr = new_aci_var_info_ptr, aci_opt_unfolder = Yes fun_ident } us_symbol_heap = writePtr case_info_ptr (EI_Extended (EEI_ActiveCase new_aci) ei) us_symbol_heap -> (fun_body, { us & us_symbol_heap = us_symbol_heap }) _ -> unfold case_expr us @@ -739,8 +739,8 @@ updateFunctionCalls calls collected_calls fun_defs symbol_table where add_function_call fc=:(FunCall fc_index _) (collected_calls, fun_defs, symbol_table) // # fc_index = trace_n ("add_function_call: "+++toString fc_index+++" ") fc_index - # ({fun_symb}, fun_defs) = fun_defs![fc_index] - (collected_calls, symbol_table) = examineFunctionCall fun_symb fc (collected_calls, symbol_table) + # ({fun_ident}, fun_defs) = fun_defs![fc_index] + (collected_calls, symbol_table) = examineFunctionCall fun_ident fc (collected_calls, symbol_table) = (collected_calls, fun_defs, symbol_table) examineFunctionCall {id_info} fc=:(FunCall fc_index _) (calls, symbol_table) @@ -877,11 +877,11 @@ copy_macro_or_local_macro_function :: !FunDef !(Optional CopiedLocalFunctions) ! copy_macro_or_local_macro_function macro=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_kind,fun_info={fi_local_vars,fi_calls}} local_macro_functions es=:{es_var_heap,es_symbol_heap} # (tb_args,es_var_heap) = create_new_arguments tb_args es_var_heap with - create_new_arguments [var=:{fv_name,fv_info_ptr} : vars] var_heap + create_new_arguments [var=:{fv_ident,fv_info_ptr} : vars] var_heap # (new_vars,var_heap) = create_new_arguments vars var_heap # (new_info, var_heap) = newPtr VI_Empty var_heap - # new_var = { fv_name = fv_name, fv_def_level = NotALevel, fv_info_ptr = new_info, fv_count = 0 } - = ([new_var : new_vars], writePtr fv_info_ptr (VI_Variable fv_name new_info) var_heap) + # new_var = { fv_ident = fv_ident, fv_def_level = NotALevel, fv_info_ptr = new_info, fv_count = 0 } + = ([new_var : new_vars], writePtr fv_info_ptr (VI_Variable fv_ident new_info) var_heap) create_new_arguments [] var_heap = ([],var_heap) # us = { us_symbol_heap = es_symbol_heap, us_var_heap = es_var_heap, us_opt_type_heaps = No,us_cleanup_info = [], @@ -904,7 +904,7 @@ copy_macro_or_local_macro_function macro=:{fun_body = TransformedBody {tb_args,t {es & es_var_heap=us_var_heap, es_symbol_heap=us_symbol_heap}) unfoldMacro :: !FunDef ![Expression] !*ExpandInfo -> (!Expression, !*ExpandInfo) -unfoldMacro {fun_body =fun_body=: TransformedBody {tb_args,tb_rhs}, fun_info = {fi_calls},fun_kind,fun_symb} args (calls, es=:{es_var_heap,es_symbol_heap,es_fun_defs}) +unfoldMacro {fun_body =fun_body=: TransformedBody {tb_args,tb_rhs}, fun_info = {fi_calls},fun_kind,fun_ident} args (calls, es=:{es_var_heap,es_symbol_heap,es_fun_defs}) # (let_binds, var_heap) = bind_expressions tb_args args [] es_var_heap #! size_fun_defs = size es_fun_defs # copied_local_functions = Yes { copied_local_functions=[],used_copied_local_functions=[],new_copied_local_functions=[],next_local_function_n=size_fun_defs} @@ -945,14 +945,14 @@ where bind_expression {fv_count} expr binds var_heap | fv_count == 0 = (binds, var_heap) - bind_expression {fv_info_ptr} (Var {var_name,var_info_ptr}) binds var_heap - = (binds, writePtr fv_info_ptr (VI_Variable var_name var_info_ptr) var_heap) - bind_expression {fv_name,fv_info_ptr,fv_count} expr binds var_heap + bind_expression {fv_info_ptr} (Var {var_ident,var_info_ptr}) binds var_heap + = (binds, writePtr fv_info_ptr (VI_Variable var_ident var_info_ptr) var_heap) + bind_expression {fv_ident,fv_info_ptr,fv_count} expr binds var_heap | fv_count == 1 = (binds, writePtr fv_info_ptr (VI_Expression expr) var_heap) # (new_info, var_heap) = newPtr VI_Empty var_heap - new_var = { fv_name = fv_name, fv_def_level = NotALevel, fv_info_ptr = new_info, fv_count = 0 } - = ([{ lb_src = expr, lb_dst = new_var, lb_position = NoPos} : binds], writePtr fv_info_ptr (VI_Variable fv_name new_info) var_heap) + new_var = { fv_ident = fv_ident, fv_def_level = NotALevel, fv_info_ptr = new_info, fv_count = 0 } + = ([{ lb_src = expr, lb_dst = new_var, lb_position = NoPos} : binds], writePtr fv_info_ptr (VI_Variable fv_ident new_info) var_heap) :: Group = { group_members :: ![Int] @@ -994,9 +994,9 @@ reset_body_of_rhs_macros pi_deps fun_defs macro_defs _ -> (fun_defs,macro_defs) -expand_simple_macro mod_index macro=:{fun_body = CheckedBody body, fun_info, fun_symb, fun_pos,fun_kind} +expand_simple_macro mod_index macro=:{fun_body = CheckedBody body, fun_info, fun_ident, fun_pos,fun_kind} predef_symbols_for_transform pi=:{pi_symbol_table,pi_symbol_heap,pi_var_heap,pi_fun_defs,pi_macro_defs,pi_error} - # identPos = newPosition fun_symb fun_pos + # identPos = newPosition fun_ident fun_pos # es = { es_symbol_table = pi_symbol_table, es_var_heap = pi_var_heap, es_symbol_heap = pi_symbol_heap, es_error = setErrorAdmin identPos pi_error, es_fun_defs=pi_fun_defs, es_macro_defs=pi_macro_defs, es_new_fun_def_numbers=[] @@ -1025,10 +1025,10 @@ macros_are_simple :: [FunCall] Int {#FunDef} {#{#FunDef}} -> Bool; macros_are_simple [] mod_index fun_defs macro_defs = True macros_are_simple [FunCall fc_index _ : calls ] mod_index fun_defs macro_defs - # {fun_kind,fun_body, fun_symb} = fun_defs.[fc_index] + # {fun_kind,fun_body, fun_ident} = fun_defs.[fc_index] = is_a_pattern_macro fun_kind fun_body && macros_are_simple calls mod_index fun_defs macro_defs macros_are_simple [MacroCall module_index fc_index _ : calls ] mod_index fun_defs macro_defs - # {fun_kind,fun_body, fun_symb} = macro_defs.[module_index,fc_index] + # {fun_kind,fun_body, fun_ident} = macro_defs.[module_index,fc_index] = is_a_pattern_macro fun_kind fun_body && macros_are_simple calls mod_index fun_defs macro_defs macros_are_simple [DclFunCall dcl_fun_index _ : calls ] mod_index fun_defs macro_defs = dcl_fun_index<>mod_index && macros_are_simple calls mod_index fun_defs macro_defs @@ -1054,8 +1054,8 @@ partitionate_dcl_macro mod_index max_fun_nr predef_symbols_for_transform macro_i # macros_pi = foldSt (visit_macro mod_index max_fun_nr predef_symbols_for_transform) macro_def.fun_info.fi_calls pi -> expand_dcl_macro_if_simple mod_index macro_index macro_def predef_symbols_for_transform macros_pi PartitioningMacro - # identPos = newPosition macro_def.fun_symb macro_def.fun_pos - -> { pi & pi_error = checkError macro_def.fun_symb "recursive macro definition" (setErrorAdmin identPos pi.pi_error) } + # identPos = newPosition macro_def.fun_ident macro_def.fun_pos + -> { pi & pi_error = checkError macro_def.fun_ident "recursive macro definition" (setErrorAdmin identPos pi.pi_error) } _ -> pi = pi @@ -1069,8 +1069,8 @@ partitionate_icl_macro mod_index max_fun_nr predef_symbols_for_transform macro_i # macros_pi = foldSt (visit_macro mod_index max_fun_nr predef_symbols_for_transform) macro_def.fun_info.fi_calls pi -> expand_icl_macro_if_simple mod_index macro_index macro_def predef_symbols_for_transform macros_pi PartitioningMacro - # identPos = newPosition macro_def.fun_symb macro_def.fun_pos - -> { pi & pi_error = checkError macro_def.fun_symb "recursive macro definition" (setErrorAdmin identPos pi.pi_error) } + # identPos = newPosition macro_def.fun_ident macro_def.fun_pos + -> { pi & pi_error = checkError macro_def.fun_ident "recursive macro definition" (setErrorAdmin identPos pi.pi_error) } _ -> pi = pi @@ -1230,7 +1230,7 @@ where = True has_no_curried_macro_Expression (TupleSelect symbol argn_nr expr) = has_no_curried_macro_Expression expr - has_no_curried_macro_Expression (MatchExpr cons_symb expr) + has_no_curried_macro_Expression (MatchExpr cons_ident expr) = has_no_curried_macro_Expression expr has_no_curried_macro_Expression expr = True @@ -1321,7 +1321,7 @@ where # pi = { pi & pi_fun_defs.[fun_index] = { fun_def & fun_info.fi_group_index = pi.pi_next_group }, pi_groups = [[FunctionOrIclMacroIndex fun_index] : pi.pi_groups] , pi_next_group = inc pi.pi_next_group } -> (max_fun_nr, pi) - -> abort ("generated function already has a group index: " +++ toString fun_def.fun_symb +++ " " +++ toString fun_index +++ "\n") + -> abort ("generated function already has a group index: " +++ toString fun_def.fun_ident +++ " " +++ toString fun_index +++ "\n") */ // do not allocate a group, it will be allocated during generic phase -> (max_fun_nr, pi) @@ -1415,8 +1415,8 @@ where where expand_macros (FunctionOrIclMacroIndex fun_index) es # (fun_def,es) = es!es_fun_defs.[fun_index] - {fun_symb,fun_body = PartitioningFunction body _, fun_info, fun_pos,fun_kind} = fun_def - identPos = newPosition fun_symb fun_pos + {fun_ident,fun_body = PartitioningFunction body _, fun_info, fun_pos,fun_kind} = fun_def + identPos = newPosition fun_ident fun_pos # es={ es & es_error = setErrorAdmin identPos es.es_error } # (tb_args, tb_rhs, fi_local_vars, fi_calls,fi_dynamics, es) = expandMacrosInBody fun_info.fi_calls body fun_info.fi_dynamics predef_symbols_for_transform es @@ -1425,8 +1425,8 @@ where = {es & es_fun_defs.[fun_index] = fun_def } expand_macros (DclMacroIndex macro_module_index fun_index) es # (old_fun_def,es) = es!es_macro_defs.[macro_module_index,fun_index] - {fun_symb,fun_body = PartitioningFunction body _, fun_info, fun_pos,fun_kind} = old_fun_def - identPos = newPosition fun_symb fun_pos + {fun_ident,fun_body = PartitioningFunction body _, fun_info, fun_pos,fun_kind} = old_fun_def + identPos = newPosition fun_ident fun_pos # es={ es & es_error = setErrorAdmin identPos es.es_error } # (tb_args, tb_rhs, fi_local_vars, fi_calls,fi_dynamics, es) = expandMacrosInBody fun_info.fi_calls body fun_info.fi_dynamics predef_symbols_for_transform es @@ -1456,7 +1456,7 @@ addFunctionCallsToSymbolTable calls fun_defs macro_defs symbol_table = foldSt add_function_call_to_symbol_table calls ([], fun_defs,macro_defs, symbol_table) where add_function_call_to_symbol_table fc=:(FunCall fc_index _) (collected_calls, fun_defs,macro_defs, symbol_table) - # ({fun_symb = { id_info }, fun_kind}, fun_defs) = fun_defs![fc_index] + # ({fun_ident = { id_info }, fun_kind}, fun_defs) = fun_defs![fc_index] = case fun_kind of FK_Macro -> (collected_calls, fun_defs,macro_defs,symbol_table) @@ -1473,7 +1473,7 @@ removeFunctionCallsFromSymbolTable calls fun_defs symbol_table = foldSt remove_function_call_from_symbol_table calls (fun_defs, symbol_table) where remove_function_call_from_symbol_table (FunCall fc_index _) (fun_defs, symbol_table) - # ({fun_symb = { id_info }}, fun_defs) = fun_defs![fc_index] + # ({fun_ident = { id_info }}, fun_defs) = fun_defs![fc_index] (entry, symbol_table) = readPtr id_info symbol_table = case entry.ste_kind of STE_Called indexes @@ -1536,7 +1536,7 @@ where // # new_function_index=trace ("new_function_index: "+++toString new_function_index+++"\n") new_function_index; # last_function_index = case local_macro_functions of (Yes {next_local_function_n}) -> next_local_function_n-1 # es = add_new_fun_defs [({old_function_n=DclMacroIndex glob_module glob_object,new_function_n=new_function_index},macro):new_functions] new_function_index last_function_index es - # (calls, es_symbol_table) = examineFunctionCall macro.fun_symb (FunCall new_function_index NotALevel) (calls, es.es_symbol_table) + # (calls, es_symbol_table) = examineFunctionCall macro.fun_ident (FunCall new_function_index NotALevel) (calls, es.es_symbol_table) # app = App { app & app_symb = { symb & symb_kind = SK_LocalMacroFunction new_function_index }, app_args = app_args } /* | macro.fun_info.fi_group_index>NoIndex @@ -1547,7 +1547,7 @@ where = (app, (calls, { es & es_symbol_table = es_symbol_table })) /* - # (calls, es_symbol_table) = examineFunctionCall macro.fun_symb {fc_index = glob_object, fc_level = NotALevel} (calls, es.es_symbol_table) + # (calls, es_symbol_table) = examineFunctionCall macro.fun_ident {fc_index = glob_object, fc_level = NotALevel} (calls, es.es_symbol_table) # app = App { app & app_symb = { symb & symb_kind = SK_Function {glob_object = glob_object, glob_module = glob_module} }, app_args = app_args } | macro.fun_info.fi_group_index<NoIndex # macro = {macro & fun_info.fi_group_index= -2-macro.fun_info.fi_group_index} @@ -1571,7 +1571,7 @@ where // # new_function_index=trace ("new_function_index: "+++toString new_function_index+++"\n") new_function_index; # last_function_index = case local_macro_functions of (Yes {next_local_function_n}) -> next_local_function_n-1 # es = add_new_fun_defs [({old_function_n=FunctionOrIclMacroIndex glob_object,new_function_n=new_function_index},macro):new_functions] new_function_index last_function_index es - # (calls, es_symbol_table) = examineFunctionCall macro.fun_symb (FunCall new_function_index NotALevel) (calls, es.es_symbol_table) + # (calls, es_symbol_table) = examineFunctionCall macro.fun_ident (FunCall new_function_index NotALevel) (calls, es.es_symbol_table) # app = App { app & app_symb = { symb & symb_kind = SK_LocalMacroFunction new_function_index }, app_args = app_args } = (app, (calls, { es & es_symbol_table = es_symbol_table })) @@ -1601,9 +1601,9 @@ where expand (TupleSelect symbol argn_nr expr) ei # (expr, ei) = expand expr ei = (TupleSelect symbol argn_nr expr, ei) - expand (MatchExpr cons_symb expr) ei + expand (MatchExpr cons_ident expr) ei # (expr, ei) = expand expr ei - = (MatchExpr cons_symb expr, ei) + = (MatchExpr cons_ident expr, ei) expand (DynamicExpr dyn) ei # (dyn, ei) = expand dyn ei = (DynamicExpr dyn, ei) @@ -1945,7 +1945,7 @@ where # (new_app_info_ptr, cos_symbol_heap) = newPtr EI_Empty cos_symbol_heap {pds_module, pds_def} = cos_predef_symbols_for_transform.predef_alias_dummy pds_ident = predefined_idents.[PD_DummyForStrictAliasFun] - app_symb = { symb_name = pds_ident, symb_kind = SK_Function {glob_module = pds_module, glob_object = pds_def} } + app_symb = { symb_ident = pds_ident, symb_kind = SK_Function {glob_module = pds_module, glob_object = pds_def} } = (App { app_symb = app_symb, app_args = [bind_src], app_info_ptr = new_app_info_ptr }, { cos & cos_symbol_heap = cos_symbol_heap } ) @@ -1997,9 +1997,9 @@ where collectVariables (TupleSelect symbol argn_nr expr) free_vars dynamics cos # (expr, free_vars, dynamics, cos) = collectVariables expr free_vars dynamics cos = (TupleSelect symbol argn_nr expr, free_vars, dynamics, cos) - collectVariables (MatchExpr cons_symb expr) free_vars dynamics cos + collectVariables (MatchExpr cons_ident expr) free_vars dynamics cos # (expr, free_vars, dynamics, cos) = collectVariables expr free_vars dynamics cos - = (MatchExpr cons_symb expr, free_vars, dynamics, cos) + = (MatchExpr cons_ident expr, free_vars, dynamics, cos) collectVariables (DynamicExpr dynamic_expr) free_vars dynamics cos # (dynamic_expr, free_vars, dynamics, cos) = collectVariables dynamic_expr free_vars dynamics cos = (DynamicExpr dynamic_expr, free_vars, dynamics, cos); @@ -2110,7 +2110,7 @@ where instance collectVariables BoundVar where - collectVariables var=:{var_name,var_info_ptr,var_expr_ptr} free_vars dynamics cos=:{cos_var_heap} + collectVariables var=:{var_ident,var_info_ptr,var_expr_ptr} free_vars dynamics cos=:{cos_var_heap} # (var_info, cos_var_heap) = readPtr var_info_ptr cos_var_heap cos = { cos & cos_var_heap = cos_var_heap } = case var_info of @@ -2120,10 +2120,10 @@ where VI_Count count is_global | count > 0 || is_global -> (var, free_vars, dynamics, { cos & cos_var_heap = writePtr var_info_ptr (VI_Count (inc count) is_global) cos.cos_var_heap }) - -> (var, [{fv_name = var_name, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel, fv_count = 0} : free_vars ], dynamics, + -> (var, [{fv_ident = var_ident, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel, fv_count = 0} : free_vars ], dynamics, { cos & cos_var_heap = writePtr var_info_ptr (VI_Count 1 is_global) cos.cos_var_heap }) _ - -> abort "collectVariables [BoundVar] (transform, 1227)" //---> (var_info ,var_name, ptrToInt var_info_ptr) + -> abort "collectVariables [BoundVar] (transform, 1227)" //---> (var_info ,var_ident, ptrToInt var_info_ptr) instance <<< (Ptr a) where diff --git a/frontend/type.icl b/frontend/type.icl index 20e5e07..6542eb4 100644 --- a/frontend/type.icl +++ b/frontend/type.icl @@ -53,7 +53,7 @@ import genericsupport // AA instance toString BoundVar where - toString varid = varid.var_name.id_name + toString varid = varid.var_ident.id_name class arraySubst type :: !type !u:{!Type} -> (!Bool,!type, !u:{! Type}) @@ -259,8 +259,8 @@ existentialError position=:(CP_Expression expr) err=:{ea_loc=[ip:_]} tryToOptimizePosition (Case {case_ident=Yes {id_name}}) = optBeautifulizeIdent id_name -tryToOptimizePosition (App {app_symb={symb_name}}) - = optBeautifulizeIdent symb_name.id_name +tryToOptimizePosition (App {app_symb={symb_ident}}) + = optBeautifulizeIdent symb_ident.id_name tryToOptimizePosition (fun @ _) = tryToOptimizePosition fun tryToOptimizePosition _ @@ -536,13 +536,13 @@ instance freshCopy [a] | freshCopy a where freshCopy l ls = mapSt freshCopy l ls -freshCopyOfAttributeVar {av_name,av_info_ptr} attr_var_heap +freshCopyOfAttributeVar {av_ident,av_info_ptr} attr_var_heap # (av_info, attr_var_heap) = readPtr av_info_ptr attr_var_heap = case av_info of AVI_Attr attr -> (attr, attr_var_heap) _ - -> abort ("freshCopyOfAttributeVar (type,icl)" ---> (av_name,av_info_ptr)) + -> abort ("freshCopyOfAttributeVar (type,icl)" ---> (av_ident,av_info_ptr)) freshCopyOfTypeAttribute (TA_Var avar) attr_var_heap @@ -559,7 +559,7 @@ freshCopyOfTypeAttribute attr attr_var_heap cIsExistential :== True cIsNotExistential :== False -freshCopyOfTypeVariable {tv_name,tv_info_ptr} type_heaps=:{th_vars} +freshCopyOfTypeVariable {tv_ident,tv_info_ptr} type_heaps=:{th_vars} # (TVI_Type fresh_var, th_vars) = readPtr tv_info_ptr th_vars = (fresh_var, { type_heaps & th_vars = th_vars }) @@ -659,9 +659,9 @@ where # (exi_attr_vars, attr_store, th_attrs) = fresh_existential_attribute atv_attribute (exi_attr_vars, attr_store, th_attrs) = (exi_attr_vars, var_store, attr_store, { type_heaps & th_vars = th_vars, th_attrs = th_attrs }) - fresh_existential_attribute (TA_Var {av_name,av_info_ptr}) (exi_attr_vars, attr_store, attr_heap) + fresh_existential_attribute (TA_Var {av_ident,av_info_ptr}) (exi_attr_vars, attr_store, attr_heap) = ([ attr_store : exi_attr_vars ], inc attr_store, attr_heap <:= (av_info_ptr, AVI_Attr (TA_TempVar attr_store))) -// ---> ("fresh_existential_attribute", av_info_ptr,av_name) +// ---> ("fresh_existential_attribute", av_info_ptr,av_ident) fresh_existential_attribute attr state = state @@ -708,7 +708,7 @@ where freshAlgebraicType :: !(Global Int) ![AlgebraicPattern] !{#CommonDefs} !*TypeState -> (![[AType]],!AType,![AttrCoercion],!*TypeState) freshAlgebraicType {glob_module, glob_object} patterns common_defs ts=:{ts_var_store,ts_attr_store,ts_type_heaps,ts_exis_variables} - # {td_rhs,td_args,td_attrs,td_name,td_attribute} = common_defs.[glob_module].com_type_defs.[glob_object] + # {td_rhs,td_args,td_attrs,td_ident,td_attribute} = common_defs.[glob_module].com_type_defs.[glob_object] # (th_vars, ts_var_store) = fresh_type_variables td_args (ts_type_heaps.th_vars, ts_var_store) (th_attrs, ts_attr_store) = fresh_attributes td_attrs (ts_type_heaps.th_attrs, ts_attr_store) ts_type_heaps = { ts_type_heaps & th_vars = th_vars, th_attrs = th_attrs } @@ -756,8 +756,8 @@ fresh_overloaded_list_type [{ap_symbol}:patterns] pd_cons_symbol pd_nil_symbol d | ap_symbol.glob_object.ds_index==pd_nil_symbol-FirstConstructorPredefinedSymbolIndex = case patterns of [] - # {ft_type,ft_symb,ft_type_ptr,ft_specials} = functions.[stdStrictLists_index].[nil_u_index] - # (fun_type_copy, ts) = determineSymbolTypeOfFunction pos ft_symb 0 ft_type ft_type_ptr common_defs ts + # {ft_type,ft_ident,ft_type_ptr,ft_specials} = functions.[stdStrictLists_index].[nil_u_index] + # (fun_type_copy, ts) = determineSymbolTypeOfFunction pos ft_ident 0 ft_type ft_type_ptr common_defs ts {tst_args,tst_result,tst_context,tst_attr_env}=fun_type_copy -> ([tst_args],tst_result,tst_context,tst_attr_env,ts) [pattern=:{ap_symbol}] @@ -767,8 +767,8 @@ fresh_overloaded_list_type [{ap_symbol}:patterns] pd_cons_symbol pd_nil_symbol d = abort "fresh_overloaded_list_type" where make_cons_type_from_decons_type stdStrictLists_index decons_u_index common_defs ts - # {me_symb,me_type,me_type_ptr} = common_defs.[stdStrictLists_index].com_member_defs.[decons_u_index] - (fun_type_copy,ts) = determineSymbolTypeOfFunction pos me_symb 1 me_type me_type_ptr common_defs ts + # {me_ident,me_type,me_type_ptr} = common_defs.[stdStrictLists_index].com_member_defs.[decons_u_index] + (fun_type_copy,ts) = determineSymbolTypeOfFunction pos me_ident 1 me_type me_type_ptr common_defs ts {tst_args,tst_arity,tst_lifted,tst_result,tst_context,tst_attr_env}=fun_type_copy # result_type = case tst_args of [t] -> t # argument_types = case tst_result.at_type of @@ -1034,7 +1034,7 @@ where = (cons_attr, attr_var_heap, attr_vars, attr_env, ps_error) addPropagationAttributesToAType :: {#CommonDefs} !AType !*PropState -> *(!AType,Int,!*PropState); -addPropagationAttributesToAType modules type=:{at_type = TA cons_id=:{type_index={glob_object,glob_module},type_name} cons_args, at_attribute} ps +addPropagationAttributesToAType modules type=:{at_type = TA cons_id=:{type_index={glob_object,glob_module},type_ident} cons_args, at_attribute} ps # (cons_args, props, ps=:{prop_td_infos,prop_type_heaps,prop_attr_vars,prop_attr_env,prop_error}) = add_propagation_attributes_to_atypes modules cons_args ps (prop_class, th_vars, prop_td_infos) = propClassification glob_object glob_module props modules prop_type_heaps.th_vars prop_td_infos @@ -1043,7 +1043,7 @@ addPropagationAttributesToAType modules type=:{at_type = TA cons_id=:{type_index = ({ type & at_type = TA cons_id cons_args, at_attribute = at_attribute }, prop_class, { ps & prop_attr_vars = prop_attr_vars, prop_td_infos = prop_td_infos, prop_attr_env = prop_attr_env, prop_type_heaps = { prop_type_heaps & th_vars = th_vars, th_attrs = th_attrs}, prop_error = prop_error }) -addPropagationAttributesToAType modules type=:{at_type = TAS cons_id=:{type_index={glob_object,glob_module},type_name} cons_args strictness, at_attribute} ps +addPropagationAttributesToAType modules type=:{at_type = TAS cons_id=:{type_index={glob_object,glob_module},type_ident} cons_args strictness, at_attribute} ps # (cons_args, props, ps=:{prop_td_infos,prop_type_heaps,prop_attr_vars,prop_attr_env,prop_error}) = add_propagation_attributes_to_atypes modules cons_args ps (prop_class, th_vars, prop_td_infos) = propClassification glob_object glob_module props modules prop_type_heaps.th_vars prop_td_infos @@ -1163,7 +1163,7 @@ standardTupleSelectorType pos {ds_index} arg_nr {ti_common_defs} ts = freshSymbolType (Yes pos) cWithFreshContextVars { cons_type & st_args = [cons_type.st_result], st_result = cons_type.st_args !! arg_nr } ti_common_defs ts standardRhsConstructorType pos index mod arity {ti_common_defs} ts - # {cons_symb, cons_type=ct=:{st_vars,st_attr_vars}, cons_exi_vars } = ti_common_defs.[mod].com_cons_defs.[index] + # {cons_ident, cons_type=ct=:{st_vars,st_attr_vars}, cons_exi_vars } = ti_common_defs.[mod].com_cons_defs.[index] (st_vars, st_attr_vars) = foldSt add_vars_and_attr cons_exi_vars (st_vars, st_attr_vars) cons_type = { ct & st_vars = st_vars, st_attr_vars = st_attr_vars } (fresh_type, ts) = freshSymbolType (Yes pos) cWithFreshContextVars cons_type ti_common_defs ts @@ -1177,16 +1177,16 @@ where add_attr_var attr attr_variables = attr_variables -// ---> ("standardRhsConstructorType", cons_symb, fresh_type) +// ---> ("standardRhsConstructorType", cons_ident, fresh_type) standardLhsConstructorType pos index mod arity {ti_common_defs} ts=:{ts_var_store,ts_attr_store,ts_type_heaps,ts_exis_variables} - # {cons_symb, cons_type, cons_exi_vars } = ti_common_defs.[mod].com_cons_defs.[index] + # {cons_ident, cons_type, cons_exi_vars } = ti_common_defs.[mod].com_cons_defs.[index] (new_exis_variables, ts_var_store, ts_attr_store, ts_type_heaps) = freshExistentialVariables cons_exi_vars ts_var_store ts_attr_store ts_type_heaps // -?-> (not (isEmpty cons_exi_vars), ("standardLhsConstructorType", cons_exi_vars, cons_type)) ts_exis_variables = addToExistentialVariables pos new_exis_variables ts_exis_variables ts = { ts & ts_type_heaps = ts_type_heaps, ts_var_store = ts_var_store, ts_attr_store = ts_attr_store, ts_exis_variables = ts_exis_variables } = freshSymbolType No cWithFreshContextVars cons_type ti_common_defs ts -// ---> ("standardLhsConstructorType", cons_symb, fresh_type) +// ---> ("standardLhsConstructorType", cons_ident, fresh_type) :: ReferenceMarking :== Bool @@ -1199,10 +1199,10 @@ storeAttribute No type_attribute symbol_heap = symbol_heap getSymbolType :: CoercionPosition TypeInput SymbIdent Int *TypeState -> *(!TempSymbolType,![Special],!*TypeState); -getSymbolType pos ti=:{ti_functions,ti_common_defs,ti_main_dcl_module_n} {symb_kind = SK_Function {glob_module,glob_object}, symb_name} n_app_args ts +getSymbolType pos ti=:{ti_functions,ti_common_defs,ti_main_dcl_module_n} {symb_kind = SK_Function {glob_module,glob_object}, symb_ident} n_app_args ts | glob_module == ti_main_dcl_module_n | glob_object>=size ts.ts_fun_env - = abort symb_name.id_name; + = abort symb_ident.id_name; # (fun_type, ts) = ts!ts_fun_env.[glob_object] = case fun_type of UncheckedType fun_type @@ -1218,12 +1218,12 @@ getSymbolType pos ti=:{ti_functions,ti_common_defs,ti_main_dcl_module_n} {symb_k (fun_type_copy,ts) = currySymbolType fun_type_copy n_app_args ts -> (fun_type_copy, [], ts) _ - -> abort ("getSymbolType: SK_Function "+++toString symb_name+++" "+++toString glob_object) -// -> abort "getSymbolType (type.icl)" ---> (symb_name, glob_object, fun_type) + -> abort ("getSymbolType: SK_Function "+++toString symb_ident+++" "+++toString glob_object) +// -> abort "getSymbolType (type.icl)" ---> (symb_ident, glob_object, fun_type) # {ft_type,ft_type_ptr,ft_specials} = ti_functions.[glob_module].[glob_object] | glob_module>=size ti_functions || glob_object>=size ti_functions.[glob_module] - = abort (toString glob_module+++" "+++toString glob_object+++" "+++toString ti_main_dcl_module_n+++" "+++symb_name.id_name); - # (fun_type_copy, ts) = determineSymbolTypeOfFunction pos symb_name n_app_args ft_type ft_type_ptr ti_common_defs ts + = abort (toString glob_module+++" "+++toString glob_object+++" "+++toString ti_main_dcl_module_n+++" "+++symb_ident.id_name); + # (fun_type_copy, ts) = determineSymbolTypeOfFunction pos symb_ident n_app_args ft_type ft_type_ptr ti_common_defs ts = (fun_type_copy, get_specials ft_specials, ts) where get_specials (SP_ContextTypes specials) = specials @@ -1231,9 +1231,9 @@ getSymbolType pos ti=:{ti_functions,ti_common_defs,ti_main_dcl_module_n} {symb_k getSymbolType pos ti {symb_kind = SK_Constructor {glob_module,glob_object}} n_app_args ts # (fresh_cons_type, ts) = standardRhsConstructorType pos glob_object glob_module n_app_args ti ts = (fresh_cons_type, [], ts) -getSymbolType pos ti=:{ti_functions,ti_common_defs,ti_main_dcl_module_n} {symb_kind = SK_LocalMacroFunction glob_object, symb_name} n_app_args ts +getSymbolType pos ti=:{ti_functions,ti_common_defs,ti_main_dcl_module_n} {symb_kind = SK_LocalMacroFunction glob_object, symb_ident} n_app_args ts | glob_object>=size ts.ts_fun_env - = abort symb_name.id_name; + = abort symb_ident.id_name; # (fun_type, ts) = ts!ts_fun_env.[glob_object] = case fun_type of UncheckedType fun_type @@ -1249,20 +1249,20 @@ getSymbolType pos ti=:{ti_functions,ti_common_defs,ti_main_dcl_module_n} {symb_k (fun_type_copy,ts) = currySymbolType fun_type_copy n_app_args ts -> (fun_type_copy, [], ts) _ - -> abort ("getSymbolType SK_LocalMacroFunction: "+++toString symb_name+++" " +++toString glob_object) -// -> abort "getSymbolType (type.icl)" ---> (symb_name, glob_object, fun_type) + -> abort ("getSymbolType SK_LocalMacroFunction: "+++toString symb_ident+++" " +++toString glob_object) +// -> abort "getSymbolType (type.icl)" ---> (symb_ident, glob_object, fun_type) getSymbolType pos ti=:{ti_common_defs} { symb_kind = SK_OverloadedFunction {glob_module,glob_object}} n_app_args ts - # {me_symb, me_type,me_type_ptr} = ti_common_defs.[glob_module].com_member_defs.[glob_object] - (fun_type_copy, ts) = determineSymbolTypeOfFunction pos me_symb n_app_args me_type me_type_ptr ti_common_defs ts + # {me_ident, me_type,me_type_ptr} = ti_common_defs.[glob_module].com_member_defs.[glob_object] + (fun_type_copy, ts) = determineSymbolTypeOfFunction pos me_ident n_app_args me_type me_type_ptr ti_common_defs ts = (fun_type_copy, [], ts) // AA.. -getSymbolType pos ti=:{ti_common_defs} symbol=:{symb_name, symb_kind = SK_Generic gen_glob kind} n_app_args ts +getSymbolType pos ti=:{ti_common_defs} symbol=:{symb_ident, symb_kind = SK_Generic gen_glob kind} n_app_args ts # (opt_member_glob, ts_generic_heap) = getGenericMember gen_glob kind ti_common_defs ts.ts_generic_heap # ts = { ts & ts_generic_heap = ts_generic_heap } = case opt_member_glob of No # empty_tst = {tst_args=[], tst_arity=0, tst_lifted=0, tst_result={at_type=TE,at_attribute=TA_Multi}, tst_context=[], tst_attr_env=[]} - # ts_error = checkError ("no generic instances of " +++ toString symb_name +++ " for kind") kind ts.ts_error + # ts_error = checkError ("no generic instances of " +++ toString symb_ident +++ " for kind") kind ts.ts_error -> (empty_tst, [], {ts & ts_error = ts_error}) Yes member_glob -> getSymbolType pos ti {symbol & symb_kind = SK_OverloadedFunction member_glob} n_app_args ts // ..AA @@ -1271,7 +1271,7 @@ class requirements a :: !TypeInput !a !(!u:Requirements, !*TypeState) -> (!AType instance requirements BoundVar where - requirements ti {var_name,var_info_ptr,var_expr_ptr} (reqs, ts) + requirements ti {var_ident,var_info_ptr,var_expr_ptr} (reqs, ts) # (var_info, ts_var_heap) = readPtr var_info_ptr ts.ts_var_heap ts = { ts & ts_var_heap = ts_var_heap } = case var_info of @@ -1282,7 +1282,7 @@ where (fresh_type, ts_type_heaps) = freshCopy type ts.ts_type_heaps -> (fresh_type, Yes var_expr_ptr, (reqs, { ts & ts_type_heaps = ts_type_heaps })) _ - -> abort "requirements BoundVar " // ---> (var_name <<- var_info)) + -> abort "requirements BoundVar " // ---> (var_ident <<- var_info)) where bind_var_and_attr {atv_attribute, atv_variable = {tv_info_ptr}} ts=:{ts_var_store, ts_attr_store, ts_type_heaps} # (ts_attr_store, th_attrs) = bind_attr atv_attribute (ts_attr_store, ts_type_heaps.th_attrs) @@ -1324,9 +1324,9 @@ where requirements_of_lifted_and_normal_args ti fun_ident arg_nr _ exprs lts reqs_ts | arg_nr>0 = requirements_of_args ti fun_ident arg_nr exprs lts reqs_ts - requirements_of_lifted_and_normal_args ti fun_ident arg_nr [{fv_name}:fun_args] [expr:exprs] [lt:lts] reqs_ts + requirements_of_lifted_and_normal_args ti fun_ident arg_nr [{fv_ident}:fun_args] [expr:exprs] [lt:lts] reqs_ts # (e_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr reqs_ts - position = CP_LiftedFunArg fun_ident.symb_name fv_name + position = CP_LiftedFunArg fun_ident.symb_ident fv_ident req_type_coercions = [{ tc_demanded = lt, tc_offered = e_type, tc_position = position, tc_coercible = True } : reqs.req_type_coercions ] ts_expr_heap = storeAttribute opt_expr_ptr lt.at_attribute ts.ts_expr_heap = requirements_of_lifted_and_normal_args ti fun_ident (arg_nr+1) fun_args exprs lts ({ reqs & req_type_coercions = req_type_coercions}, { ts & ts_expr_heap = ts_expr_heap }) @@ -1336,7 +1336,7 @@ where = reqs_ts requirements_of_args ti fun_ident arg_nr [expr:exprs] [lt:lts] reqs_ts # (e_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr reqs_ts - req_type_coercions = [{ tc_demanded = lt, tc_offered = e_type, tc_position = CP_FunArg fun_ident.symb_name arg_nr, tc_coercible = True } : reqs.req_type_coercions ] + req_type_coercions = [{ tc_demanded = lt, tc_offered = e_type, tc_position = CP_FunArg fun_ident.symb_ident arg_nr, tc_coercible = True } : reqs.req_type_coercions ] ts_expr_heap = storeAttribute opt_expr_ptr lt.at_attribute ts.ts_expr_heap = requirements_of_args ti fun_ident (arg_nr+1) exprs lts ({ reqs & req_type_coercions = req_type_coercions}, { ts & ts_expr_heap = ts_expr_heap }) @@ -1461,16 +1461,16 @@ where = ({ reqs & req_type_coercions = [ { tc_demanded = goal_type, tc_offered = res_type, tc_position = CP_Expression expr, tc_coercible = True } : reqs.req_type_coercions] }, { ts & ts_expr_heap = ts_expr_heap }) - update_case_variable (Var {var_name,var_info_ptr,var_expr_ptr}) [cons_types] var_heap + update_case_variable (Var {var_ident,var_info_ptr,var_expr_ptr}) [cons_types] var_heap # (var_info, var_heap) = readPtr var_info_ptr var_heap -// ---> ("update_case_variable 1", var_name, cons_types) +// ---> ("update_case_variable 1", var_ident, cons_types) = case var_info of VI_Type type type_info -> var_heap <:= (var_info_ptr, VI_Type type (VITI_PatternType cons_types type_info)) VI_FAType vars type type_info -> var_heap <:= (var_info_ptr, VI_FAType vars type (VITI_PatternType cons_types type_info)) _ - -> abort "update_case_variable" // ---> (var_name <<- var_info)) + -> abort "update_case_variable" // ---> (var_ident <<- var_info)) update_case_variable expr cons_types var_heap = var_heap // ---> ("update_case_variable 2", expr, cons_types) @@ -1487,9 +1487,9 @@ where = ( res_type, opt_expr_ptr, ({ reqs & req_case_and_let_exprs = [let_info_ptr : reqs.req_case_and_let_exprs]},{ ts & ts_expr_heap = ts_expr_heap })) where - make_base [{lb_src, lb_dst={fv_name, fv_info_ptr}}:bs] var_types ts=:{ts_var_heap} + make_base [{lb_src, lb_dst={fv_ident, fv_info_ptr}}:bs] var_types ts=:{ts_var_heap} # (v, ts) = freshAttributedVariable ts - optional_position = if (is_rare_name fv_name) (VITI_Coercion (CP_Expression lb_src)) VITI_Empty + optional_position = if (is_rare_name fv_ident) (VITI_Coercion (CP_Expression lb_src)) VITI_Empty = make_base bs [v:var_types] { ts & ts_var_heap = writePtr fv_info_ptr (VI_Type v optional_position) ts.ts_var_heap } make_base [] var_types ts = (var_types, ts) @@ -1795,7 +1795,7 @@ requirementsOfSelector ti opt_expr expr (ArraySelection {glob_object = {ds_ident = (True, tst_result, (reqs, ts)) = (True, tst_result, ({ reqs & req_overloaded_calls = [expr_ptr : reqs.req_overloaded_calls ]}, { ts & ts_expr_heap = ts.ts_expr_heap <:= (expr_ptr, EI_Overloaded { oc_symbol = - { symb_name = ds_ident, symb_kind = SK_OverloadedFunction {glob_module = glob_module, glob_object = ds_index}}, + { symb_ident = ds_ident, symb_kind = SK_OverloadedFunction {glob_module = glob_module, glob_object = ds_index}}, oc_context = tst_context, oc_specials = [] })})) where array_and_index_type [array_type, index_type : rest_type ] @@ -1855,8 +1855,8 @@ possibly_accumulate_reqs_in_new_group position state_transition reqs_ts makeBase _ _ [] [] ts_var_heap = ts_var_heap -makeBase fun_or_cons_ident arg_nr [{fv_name, fv_info_ptr} : vars] [type : types] ts_var_heap - | is_rare_name fv_name +makeBase fun_or_cons_ident arg_nr [{fv_ident, fv_info_ptr} : vars] [type : types] ts_var_heap + | is_rare_name fv_ident = makeBase fun_or_cons_ident (arg_nr+1) vars types (addToBase fv_info_ptr type (VITI_Coercion (CP_FunArg fun_or_cons_ident arg_nr)) ts_var_heap) = makeBase fun_or_cons_ident (arg_nr+1) vars types (addToBase fv_info_ptr type VITI_Empty ts_var_heap) @@ -1893,10 +1893,10 @@ CreateInitialSymbolTypes start_index common_defs [fun : funs] (pre_def_symbols, = CreateInitialSymbolTypes start_index common_defs funs (pre_def_symbols, ts) where initial_symbol_type is_start_rule common_defs - {fun_symb, fun_type = Yes ft=:{st_arity,st_args,st_result,st_attr_vars,st_attr_env},fun_lifted, + {fun_ident, fun_type = Yes ft=:{st_arity,st_args,st_result,st_attr_vars,st_attr_env},fun_lifted, fun_info = {fi_dynamics}, fun_pos } (pre_def_symbols, ts=:{ts_type_heaps,ts_expr_heap,ts_td_infos,ts_error}) - # fe_location = newPosition fun_symb fun_pos + # fe_location = newPosition fun_ident fun_pos ts_error = setErrorAdmin fe_location ts_error (st_args, ps) = addPropagationAttributesToATypes common_defs st_args { prop_type_heaps = ts_type_heaps, prop_td_infos = ts_td_infos, @@ -1977,7 +1977,7 @@ where (pds, predef_symbols) = predef_symbols![PD_TypeCodeMember] ({pds_module,pds_def},predef_symbols) = predef_symbols![PD_TypeCodeMember] pds_ident = predefined_idents.[PD_TypeCodeMember] - tc_member_symb = { symb_name = pds_ident, symb_kind = SK_OverloadedFunction {glob_module = pds_module, glob_object = pds_def }} + tc_member_symb = { symb_ident = pds_ident, symb_kind = SK_OverloadedFunction {glob_module = pds_module, glob_object = pds_def }} (new_var_ptr, var_heap) = newPtr VI_Empty var_heap context = {tc_class = TCClass tc_class_symb, tc_types = [fresh_var], tc_var = new_var_ptr} (expr_ptr, expr_heap) = newPtr EI_Empty expr_heap @@ -2043,7 +2043,7 @@ where tc_class_symb = {glob_module = pds_module, glob_object = {ds_ident = pds_ident, ds_arity = 1, ds_index = pds_def }} ({pds_module,pds_def},predef_symbols) = predef_symbols![PD_TypeCodeMember] pds_ident = predefined_idents.[PD_TypeCodeMember] - tc_member_symb = { symb_name = pds_ident, symb_kind = SK_TypeCode} + tc_member_symb = { symb_ident = pds_ident, symb_kind = SK_TypeCode} (contexts, (var_heap, type_var_heap)) = mapSt (build_type_context tc_class_symb) global_vars (var_heap, type_var_heap) (expr_ptr, expr_heap) = newPtr EI_Empty expr_heap = (contexts, expr_ptr, tc_member_symb, (var_heap, expr_heap, type_var_heap, predef_symbols)) @@ -2084,10 +2084,10 @@ where = ptrs = get_dict_ptrs fun_index dict_types - clean_up_and_check_function_type {fun_symb,fun_pos,fun_type = opt_fun_type} fun is_start_rule list_inferred_types defs type_contexts type_ptrs + clean_up_and_check_function_type {fun_ident,fun_pos,fun_type = opt_fun_type} fun is_start_rule list_inferred_types defs type_contexts type_ptrs coercion_env attr_partition type_var_env attr_var_env out ts # (env_type, ts) = ts!ts_fun_env.[fun] - # ts = { ts & ts_error = setErrorAdmin (newPosition fun_symb fun_pos) ts.ts_error} + # ts = { ts & ts_error = setErrorAdmin (newPosition fun_ident fun_pos) ts.ts_error} = case env_type of ExpandedType fun_type tmp_fun_type exp_fun_type # (clean_fun_type, type_var_env, attr_var_env, ts_type_heaps, ts_var_heap, ts_expr_heap, ts_error) @@ -2116,7 +2116,7 @@ where -> beautifulizeAttributes clean_fun_type th_attrs _ -> (clean_fun_type, th_attrs) - -> (out <<< fun_symb <<< " :: " + -> (out <<< fun_ident <<< " :: " <:: (form, printable_type, Yes initialTypeVarBeautifulizer) <<< '\n', th_attrs) ts_fun_env = { ts.ts_fun_env & [fun] = CheckedType clean_fun_type } -> (type_var_env, attr_var_env, out, { ts & ts_type_heaps = { ts_type_heaps & th_attrs = th_attrs }, ts_var_heap = ts_var_heap, ts_expr_heap = ts_expr_heap, ts_fun_env = ts_fun_env, ts_error = ts_error }) @@ -2289,7 +2289,7 @@ where = state check_type_of_constructor_variable_for_TA glob_module glob_object type_arity types ins_pos common_defs type error type_var_heap td_infos - # {td_arity,td_name} = common_defs.[glob_module].com_type_defs.[glob_object] + # {td_arity,td_ident} = common_defs.[glob_module].com_type_defs.[glob_object] ({tdi_properties,tdi_cons_vars}, td_infos) = td_infos![glob_module].[glob_object] | tdi_properties bitand cIsNonCoercible == 0 # ({sc_neg_vect}, type_var_heap, td_infos) @@ -2336,8 +2336,8 @@ where = foldSt show_fun comp ([], fun_defs) where show_fun fun_index (names, fun_defs) - # ({fun_symb}, fun_defs) = fun_defs![fun_index] - = ([fun_symb : names], fun_defs) + # ({fun_ident}, fun_defs) = fun_defs![fun_index] + = ([fun_ident : names], fun_defs) get_index_of_start_rule predef_symbols # ({pds_def, pds_module}, predef_symbols) = predef_symbols![PD_Start] @@ -2467,8 +2467,8 @@ where -> (*{!Type}, !*TypeHeaps, !*ErrorAdmin) unify_requirements_within_one_position _ ti {tcg_type_coercions, tcg_position=NoPos} (subst, heaps, ts_error) = unify_coercions tcg_type_coercions ti subst heaps ts_error - unify_requirements_within_one_position fun_symb ti {tcg_type_coercions, tcg_position} (subst, heaps, ts_error) - # ts_error = setErrorAdmin (newPosition fun_symb tcg_position) ts_error + unify_requirements_within_one_position fun_ident ti {tcg_type_coercions, tcg_position} (subst, heaps, ts_error) + # ts_error = setErrorAdmin (newPosition fun_ident tcg_position) ts_error = unify_coercions tcg_type_coercions ti subst heaps ts_error build_initial_coercion_env [{fe_requirements={req_attr_coercions},fe_location} : reqs_list] coercion_env @@ -2504,9 +2504,9 @@ where build_coercion_env [] subst coercion_env common_defs cons_var_vects type_signs type_var_heap error = (subst, coercion_env, type_signs, type_var_heap, error) - build_coercion_env_for_alternative fun_symb common_defs cons_var_vects {tcg_position, tcg_type_coercions} + build_coercion_env_for_alternative fun_ident common_defs cons_var_vects {tcg_position, tcg_type_coercions} (subst, coercion_env, type_signs, type_var_heap, error) - # error = setErrorAdmin (newPosition fun_symb tcg_position) error + # error = setErrorAdmin (newPosition fun_ident tcg_position) error = add_to_coercion_env tcg_type_coercions subst coercion_env common_defs cons_var_vects type_signs type_var_heap error add_to_coercion_env [{tc_offered,tc_demanded,tc_coercible,tc_position} : attr_coercions] subst coercion_env common_defs cons_var_vects type_signs type_var_heap error @@ -2632,10 +2632,10 @@ where type_function ti fun_index ts=:{ts_fun_env, ts_var_heap, ts_error, ts_fun_defs} # (fd, ts_fun_defs) = ts_fun_defs![fun_index] (type, ts_fun_env) = ts_fun_env![fun_index] - {fun_symb,fun_arity,fun_body=TransformedBody {tb_args,tb_rhs},fun_pos, fun_info, fun_type} = fd + {fun_ident,fun_arity,fun_body=TransformedBody {tb_args,tb_rhs},fun_pos, fun_info, fun_type} = fd temp_fun_type = type_of type - ts_var_heap = makeBase fun_symb 1 tb_args temp_fun_type.tst_args ts_var_heap - fe_location = newPosition fun_symb fun_pos + ts_var_heap = makeBase fun_ident 1 tb_args temp_fun_type.tst_args ts_var_heap + fe_location = newPosition fun_ident fun_pos ts_error = setErrorAdmin fe_location ts_error // ts = { ts & ts_var_heap = ts_var_heap, ts_error = ts_error} ts = { ts & ts_var_heap = ts_var_heap, ts_error = ts_error, ts_fun_defs = ts_fun_defs, ts_fun_env = ts_fun_env} @@ -2651,7 +2651,7 @@ where fe_requirements = { rhs_reqs & req_type_coercions = [], req_type_coercion_groups = req_type_coercion_groups } }, ({ ts & ts_expr_heap = ts_expr_heap })) -// ---> ("type_function", fun_symb, tb_args, tb_rhs, fun_info.fi_local_vars) +// ---> ("type_function", fun_ident, tb_args, tb_rhs, fun_info.fi_local_vars) where has_option (Yes _) = True has_option No = False @@ -2665,7 +2665,7 @@ where add_extra_elements_to_fun_def_array n_new_elements fun_defs | n_new_elements==0 = fun_defs - # dummy_fun_def = { fun_symb = {id_name="",id_info=nilPtr},fun_arity=0,fun_priority=NoPrio,fun_body=NoBody,fun_type=No,fun_pos=NoPos, + # dummy_fun_def = { fun_ident = {id_name="",id_info=nilPtr},fun_arity=0,fun_priority=NoPrio,fun_body=NoBody,fun_type=No,fun_pos=NoPos, fun_kind=FK_Unknown,fun_lifted=0,fun_info = {fi_calls=[],fi_group_index=0,fi_def_level=NotALevel,fi_free_vars=[],fi_local_vars=[],fi_dynamics=[],fi_properties=0}} = {createArray (size fun_defs+n_new_elements) dummy_fun_def & [i]=fun_defs.[i] \\ i<-[0..size fun_defs-1]} (array_first_instance_indices,fun_defs, predef_symbols, type_heaps, error) @@ -2712,13 +2712,13 @@ where = create_instance_types members array_members unboxed_array_type offset_table record_type member_index funs_heaps_and_error create_instance_type members array_members unboxed_array_type offset_table record_type member_index (fun_defs, type_heaps, error) - # {me_type,me_symb,me_class_vars,me_pos} = array_members.[members.[member_index].ds_index] + # {me_type,me_ident,me_class_vars,me_pos} = array_members.[members.[member_index].ds_index] (instance_type, _, type_heaps, _, error) = determineTypeOfMemberInstance me_type me_class_vars {it_vars = [], it_attr_vars = [], it_context = [], it_types = [unboxed_array_type, record_type]} SP_None type_heaps No error instance_type = makeElemTypeOfArrayFunctionStrict instance_type member_index offset_table fun_index = first_instance_index+member_index fun = - { fun_symb = me_symb + { fun_ident = me_ident , fun_arity = me_type.st_arity , fun_priority = NoPrio , fun_body = NoBody @@ -2755,12 +2755,12 @@ where = create_instance_types members list_members record_type member_index funs_heaps_and_error create_instance_type members list_members record_type member_index (fun_defs, type_heaps, error) - # {me_type,me_symb,me_class_vars,me_pos} = list_members.[members.[member_index].ds_index] + # {me_type,me_ident,me_class_vars,me_pos} = list_members.[members.[member_index].ds_index] (instance_type, _, type_heaps, _, error) = determineTypeOfMemberInstance me_type me_class_vars {it_vars = [], it_attr_vars = [], it_context = [], it_types = [record_type]} SP_None type_heaps No error fun_index = first_instance_index+member_index fun = - { fun_symb = me_symb + { fun_ident = me_ident , fun_arity = me_type.st_arity , fun_priority = NoPrio , fun_body = NoBody diff --git a/frontend/type_io.icl b/frontend/type_io.icl index e6b6994..3a3d7f4 100644 --- a/frontend/type_io.icl +++ b/frontend/type_io.icl @@ -60,7 +60,7 @@ where instance WriteTypeInfo ConsDef where - write_type_info {cons_symb,cons_type,cons_arg_vars,cons_priority,cons_index,cons_type_index,cons_exi_vars} tcl_file wtis=:{wtis_n_type_vars} + write_type_info {cons_ident,cons_type,cons_arg_vars,cons_priority,cons_index,cons_type_index,cons_exi_vars} tcl_file wtis=:{wtis_n_type_vars} // normalize ... # (th_vars,wtis) = sel_type_var_heap wtis @@ -71,7 +71,7 @@ where // ... normalize # (tcl_file,wtis) - = write_type_info cons_symb tcl_file wtis + = write_type_info cons_ident tcl_file wtis # (tcl_file,wtis) = write_type_info cons_type tcl_file wtis @@ -93,7 +93,7 @@ instance WriteTypeInfo TypeDef TypeRhs instance WriteTypeInfo (TypeDef TypeRhs) 0.2*/ where - write_type_info {td_name,td_arity,td_args,td_rhs} tcl_file wtis + write_type_info {td_ident,td_arity,td_args,td_rhs} tcl_file wtis // normalize ... # (th_vars,wtis) = sel_type_var_heap wtis @@ -107,7 +107,7 @@ where // ... normalize # (tcl_file,wtis) - = write_type_info td_name tcl_file wtis + = write_type_info td_ident tcl_file wtis # (tcl_file,wtis) = write_type_info td_arity tcl_file wtis # (tcl_file,wtis) @@ -211,9 +211,9 @@ where instance WriteTypeInfo FieldSymbol where - write_type_info {fs_name,fs_var,fs_index} tcl_file wtis + write_type_info {fs_ident,fs_var,fs_index} tcl_file wtis # (tcl_file,wtis) - = write_type_info fs_name tcl_file wtis + = write_type_info fs_ident tcl_file wtis # (tcl_file,wtis) = write_type_info fs_var tcl_file wtis # (tcl_file,wtis) @@ -385,14 +385,14 @@ where instance WriteTypeInfo TypeSymbIdent where - write_type_info tsi=:{type_name,type_arity,type_index={glob_module,glob_object}} tcl_file wtis=:{wtis_predefined_module_def} + write_type_info tsi=:{type_ident,type_arity,type_index={glob_module,glob_object}} tcl_file wtis=:{wtis_predefined_module_def} # is_type_without_definition = glob_module == wtis_predefined_module_def # tcl_file = fwritec (if is_type_without_definition TypeSymbIdentWithoutDefinition TypeSymbIdentWithDefinition) tcl_file # (tcl_file,wtis) - = write_type_info type_name tcl_file wtis + = write_type_info type_ident tcl_file wtis # (tcl_file,wtis) = write_type_info type_arity tcl_file wtis # (tcl_file,wtis) diff --git a/frontend/type_io_common.dcl b/frontend/type_io_common.dcl index d8df928..57da1d8 100644 --- a/frontend/type_io_common.dcl +++ b/frontend/type_io_common.dcl @@ -79,10 +79,10 @@ FunctionTypeConstructorAsString :== " -> " // instance toString GlobalTCType -create_type_string type_name module_name - :== if (type_name == FunctionTypeConstructorAsString) - type_name - (type_name +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ module_name ) "")) +create_type_string type_ident module_name + :== if (type_ident == FunctionTypeConstructorAsString) + type_ident + (type_ident +++ (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 15ce77c..db36510 100644 --- a/frontend/type_io_common.icl +++ b/frontend/type_io_common.icl @@ -81,24 +81,24 @@ instance toString GlobalTCType where toString (GTT_Basic basic_type) = create_type_string (toString basic_type) PredefinedModuleName toString GTT_Function = FunctionTypeConstructorAsString - 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) "") + toString (GTT_Constructor _ type_symb_indent mod_ident _) = create_type_string type_symb_indent.type_ident.id_name mod_ident +// +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ mod_ident) "") */ -create_type_string type_name module_name - :== if (type_name == FunctionTypeConstructorAsString) - type_name - (type_name +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ module_name ) "")) +create_type_string type_ident module_name + :== if (type_ident == FunctionTypeConstructorAsString) + type_ident + (type_ident +++ (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_ident = type_string % (0,dec sep_pos) #! module_name = type_string % (inc sep_pos,dec (size type_string)) - = (type_name,module_name) + = (type_ident,module_name) | type_string == FunctionTypeConstructorAsString = (type_string,PredefinedModuleName) where diff --git a/frontend/typesupport.icl b/frontend/typesupport.icl index 0f01704..154ff28 100644 --- a/frontend/typesupport.icl +++ b/frontend/typesupport.icl @@ -126,7 +126,7 @@ where clean_up_attribute_variable av_group_nr (TA_None, cus=:{cus_heaps,cus_attr_store,cus_attr_env}) # (av_info_ptr, th_attrs) = newPtr AVI_Empty cus_heaps.th_attrs - new_attr_var = TA_Var { av_name = NewAttrVarId cus_attr_store, av_info_ptr = av_info_ptr } + new_attr_var = TA_Var { av_ident = NewAttrVarId cus_attr_store, av_info_ptr = av_info_ptr } = (new_attr_var, { cus & cus_attr_env = { cus_attr_env & [av_group_nr] = new_attr_var}, cus_heaps = { cus_heaps & th_attrs = th_attrs }, cus_attr_store = inc cus_attr_store}) clean_up_attribute_variable av_group_nr attr_and_cus @@ -200,7 +200,7 @@ where cleanUpVariable _ TE tv_number cus=:{cus_heaps,cus_var_store,cus_var_env} # (tv_info_ptr, th_vars) = newPtr TVI_Empty cus_heaps.th_vars - new_var = TV { tv_name = NewVarId cus_var_store, tv_info_ptr = tv_info_ptr } + new_var = TV { tv_ident = NewVarId cus_var_store, tv_info_ptr = tv_info_ptr } = (new_var, { cus & cus_var_env = { cus_var_env & [tv_number] = new_var}, cus_heaps = { cus_heaps & th_vars = th_vars }, cus_var_store = inc cus_var_store}) cleanUpVariable top_level (TLifted var) tv_number cus=:{cus_error} @@ -330,9 +330,9 @@ newAttributedVariables var_number attributed_variables clean_state=:(_,_,_) /* T newAttributedVariable var_number (variables, attributes, type_heaps=:{th_vars,th_attrs}) # (tv_info_ptr, th_vars) = newPtr TVI_Empty th_vars - new_var = { tv_name = NewVarId var_number, tv_info_ptr = tv_info_ptr } + new_var = { tv_ident = NewVarId var_number, tv_info_ptr = tv_info_ptr } (av_info_ptr, th_attrs) = newPtr AVI_Empty th_attrs - new_attr_var = { av_name = NewAttrVarId var_number, av_info_ptr = av_info_ptr } + new_attr_var = { av_ident = NewAttrVarId var_number, av_info_ptr = av_info_ptr } = ({ at_attribute = TA_Var new_attr_var, at_type = TV new_var}, ([ new_var : variables ], [ new_attr_var : attributes ], { type_heaps & th_vars = th_vars, th_attrs = th_attrs })) @@ -684,7 +684,7 @@ where instance substitute TypeAttribute where - substitute (TA_Var {av_name, av_info_ptr}) heaps=:{th_attrs} + substitute (TA_Var {av_ident, av_info_ptr}) heaps=:{th_attrs} #! av_info = sreadPtr av_info_ptr th_attrs = case av_info of AVI_Attr attr @@ -1353,44 +1353,44 @@ where = abort ("<:: (Type) (typesupport.icl)" ---> type) writeTypeTA :: !*File !(Optional TypeVarBeautifulizer) !Format !TypeSymbIdent !a -> (!*File, !Optional TypeVarBeautifulizer) | writeType a -writeTypeTA file opt_beautifulizer form {type_name,type_index,type_arity} types +writeTypeTA file opt_beautifulizer form {type_ident,type_index,type_arity} types | is_predefined type_index - | type_name.id_name=="_List" + | type_ident.id_name=="_List" = writeWithinBrackets "[" "]" file opt_beautifulizer (setProperty form cCommaSeparator, types) - | type_name.id_name=="_!List" + | type_ident.id_name=="_!List" = writeWithinBrackets "[!" "]" file opt_beautifulizer (setProperty form cCommaSeparator, types) - | type_name.id_name=="_#List" + | type_ident.id_name=="_#List" = writeWithinBrackets "[#" "]" file opt_beautifulizer (setProperty form cCommaSeparator, types) - | type_name.id_name=="_List!" + | type_ident.id_name=="_List!" = writeWithinBrackets "[" "!]" file opt_beautifulizer (setProperty form cCommaSeparator, types) - | type_name.id_name=="_!List!" + | type_ident.id_name=="_!List!" = writeWithinBrackets "[!" "!]" file opt_beautifulizer (setProperty form cCommaSeparator, types) - | type_name.id_name=="_#List!" + | type_ident.id_name=="_#List!" = writeWithinBrackets "[#" "!]" file opt_beautifulizer (setProperty form cCommaSeparator, types) - | is_lazy_array type_name + | is_lazy_array type_ident = writeWithinBrackets "{" "}" file opt_beautifulizer (setProperty form cCommaSeparator, types) - | is_strict_array type_name + | is_strict_array type_ident = writeWithinBrackets "{!" "}" file opt_beautifulizer (setProperty form cCommaSeparator, types) - | is_unboxed_array type_name + | is_unboxed_array type_ident = writeWithinBrackets "{#" "}" file opt_beautifulizer (setProperty form cCommaSeparator, types) - | is_tuple type_name type_arity + | is_tuple type_ident type_arity = writeWithinBrackets "(" ")" file opt_beautifulizer (setProperty form cCommaSeparator, types) - | is_string_type type_name + | is_string_type type_ident = (file <<< "String", opt_beautifulizer) | type_arity == 0 - = (file <<< type_name, opt_beautifulizer) + = (file <<< type_ident, opt_beautifulizer) | checkProperty form cBrackets # (file, opt_beautifulizer) - = writeType (file <<< '(' <<< type_name <<< ' ') opt_beautifulizer (form, types) + = writeType (file <<< '(' <<< type_ident <<< ' ') opt_beautifulizer (form, types) = (file <<< ')', opt_beautifulizer) - = writeType (file <<< type_name <<< ' ') opt_beautifulizer (setProperty form cBrackets, types) + = writeType (file <<< type_ident <<< ' ') opt_beautifulizer (setProperty form cBrackets, types) | type_arity == 0 - = (file <<< type_name, opt_beautifulizer) + = (file <<< type_ident, opt_beautifulizer) | checkProperty form cBrackets # (file, opt_beautifulizer) - = writeType (file <<< '(' <<< type_name <<< ' ') opt_beautifulizer (form, types) + = writeType (file <<< '(' <<< type_ident <<< ' ') opt_beautifulizer (form, types) = (file <<< ')', opt_beautifulizer) - = writeType (file <<< type_name <<< ' ') opt_beautifulizer (setProperty form cBrackets, types) + = writeType (file <<< type_ident <<< ' ') opt_beautifulizer (setProperty form cBrackets, types) where is_predefined {glob_module} = glob_module == cPredefinedModuleIndex diff --git a/frontend/unitype.icl b/frontend/unitype.icl index a5f512f..66ed942 100644 --- a/frontend/unitype.icl +++ b/frontend/unitype.icl @@ -258,7 +258,7 @@ typeIsNonCoercible _ _ class lift a :: !{# CommonDefs } !{# BOOLVECT } !a !*{! Type} !*LiftState -> (!Bool,!a, !*{! Type}, !*LiftState) -liftTypeApplication modules cons_vars t0=:(TA cons_id=:{type_name,type_index={glob_object,glob_module},type_arity,type_prop=type_prop0} cons_args) subst ls +liftTypeApplication modules cons_vars t0=:(TA cons_id=:{type_ident,type_index={glob_object,glob_module},type_arity,type_prop=type_prop0} cons_args) subst ls # ({tdi_kinds}, ls) = ls!ls_td_infos.[glob_module].[glob_object] # (changed,cons_args, sign_classes, prop_classes, subst, ls=:{ls_type_heaps}) = lift_list modules cons_vars cons_args tdi_kinds subst ls | changed @@ -272,7 +272,7 @@ liftTypeApplication modules cons_vars t0=:(TA cons_id=:{type_name,type_index={gl | equal_type_prop type_prop type_prop0 = (False, t0, subst, ls) = (True, TA { cons_id & type_prop = type_prop } cons_args, subst, ls) -liftTypeApplication modules cons_vars t0=:(TAS cons_id=:{type_name,type_index={glob_object,glob_module},type_arity,type_prop=type_prop0} cons_args strictness) subst ls +liftTypeApplication modules cons_vars t0=:(TAS cons_id=:{type_ident,type_index={glob_object,glob_module},type_arity,type_prop=type_prop0} cons_args strictness) subst ls # ({tdi_kinds}, ls) = ls!ls_td_infos.[glob_module].[glob_object] # (changed,cons_args, sign_classes, prop_classes, subst, ls=:{ls_type_heaps}) = lift_list modules cons_vars cons_args tdi_kinds subst ls | changed @@ -426,12 +426,12 @@ where = (False, attr_type, subst_and_es) where expand_attribute :: TypeAttribute *(Heap AttrVarInfo) -> (!.Bool,TypeAttribute,!.Heap AttrVarInfo); - expand_attribute (TA_Var {av_name,av_info_ptr}) attr_var_heap + expand_attribute (TA_Var {av_ident,av_info_ptr}) attr_var_heap = case (readPtr av_info_ptr attr_var_heap) of (AVI_Attr attr, attr_var_heap) -> (True, attr, attr_var_heap) (info, attr_var_heap) - -> abort ("expand_attribute (unitype.icl)" )//---> (av_name <<- info )) + -> abort ("expand_attribute (unitype.icl)" )//---> (av_ident <<- info )) expand_attribute attr attr_var_heap = (False, attr, attr_var_heap) @@ -476,7 +476,7 @@ where = (True, TArrow1 arg_type, es) = (False, type, es) //..AA - expandType modules cons_vars t0=:(TA cons_id=:{type_name, type_index={glob_object,glob_module},type_prop=type_prop0} cons_args) (subst, es) + expandType modules cons_vars t0=:(TA cons_id=:{type_ident, type_index={glob_object,glob_module},type_prop=type_prop0} cons_args) (subst, es) # ({tdi_kinds}, es) = es!es_td_infos.[glob_module].[glob_object] (changed,cons_args, hio_signs, hio_props, (subst,es=:{es_td_infos,es_type_heaps})) = expand_type_list modules cons_vars cons_args tdi_kinds (subst, es) | changed @@ -492,7 +492,7 @@ where = (False,t0, (subst, es)) # es = { es & es_td_infos = es_td_infos, es_type_heaps = { es_type_heaps & th_vars = th_vars }} = (True,TA { cons_id & type_prop = type_prop } cons_args, (subst, es)) - expandType modules cons_vars t0=:(TAS cons_id=:{type_name, type_index={glob_object,glob_module},type_prop=type_prop0} cons_args strictness) (subst, es) + expandType modules cons_vars t0=:(TAS cons_id=:{type_ident, type_index={glob_object,glob_module},type_prop=type_prop0} cons_args strictness) (subst, es) # ({tdi_kinds}, es) = es!es_td_infos.[glob_module].[glob_object] (changed,cons_args, hio_signs, hio_props, (subst,es=:{es_td_infos,es_type_heaps})) = expand_type_list modules cons_vars cons_args tdi_kinds (subst, es) | changed @@ -821,11 +821,11 @@ where = TopSign adjust_sign sign (_ :@: _) cons_vars = TopSign - adjust_sign sign (TA {type_name, type_prop={tsp_coercible}} _) cons_vars + adjust_sign sign (TA {type_ident, type_prop={tsp_coercible}} _) cons_vars | tsp_coercible = sign = TopSign - adjust_sign sign (TAS {type_name, type_prop={tsp_coercible}} _ _) cons_vars + adjust_sign sign (TAS {type_ident, type_prop={tsp_coercible}} _ _) cons_vars | tsp_coercible = sign = TopSign @@ -864,7 +864,7 @@ where tryToExpandTypeSyn :: !{#CommonDefs} !{#BOOLVECT} !Type !TypeSymbIdent ![AType] !TypeAttribute !*TypeHeaps !*TypeDefInfos -> (!Bool, !Type, !*TypeHeaps, !*TypeDefInfos) tryToExpandTypeSyn defs cons_vars type cons_id=:{type_index={glob_object,glob_module}} type_args attribute type_heaps td_infos - # {td_rhs,td_args,td_attribute,td_name} = defs.[glob_module].com_type_defs.[glob_object] + # {td_rhs,td_args,td_attribute,td_ident} = defs.[glob_module].com_type_defs.[glob_object] = case td_rhs of SynType {at_type} # type_heaps = bindTypeVarsAndAttributes td_attribute attribute td_args type_args type_heaps |