Commit 92f5b785 authored by Artem Alimarine's avatar Artem Alimarine
Browse files

OBJECT marking is added

parent 21e2e60d
......@@ -3491,12 +3491,13 @@ where
<=< adjustPredefSymbol PD_ConsCONS mod_index STE_Constructor
<=< adjustPredefSymbol PD_TypeFIELD mod_index STE_Type
<=< adjustPredefSymbol PD_ConsFIELD mod_index STE_Constructor
<=< adjustPredefSymbol PD_TypeREC mod_index STE_Type
<=< adjustPredefSymbol PD_ConsREC mod_index STE_Constructor
<=< adjustPredefSymbol PD_TypeOBJECT mod_index STE_Type
<=< adjustPredefSymbol PD_ConsOBJECT mod_index STE_Constructor
<=< adjustPredefSymbol PD_GenericInfo mod_index STE_Type
<=< adjustPredefSymbol PD_NoGenericInfo mod_index STE_Constructor
<=< adjustPredefSymbol PD_GenericConsInfo mod_index STE_Constructor
<=< adjustPredefSymbol PD_GenericFieldInfo mod_index STE_Constructor
<=< adjustPredefSymbol PD_GenericTypeInfo mod_index STE_Constructor
<=< adjustPredefSymbol PD_TGenericConsDescriptor mod_index STE_Type
<=< adjustPredefSymbol PD_CGenericConsDescriptor mod_index STE_Constructor
<=< adjustPredefSymbol PD_TGenericFieldDescriptor mod_index STE_Type
......
......@@ -305,7 +305,6 @@ where
//---> ("build generic representation", type_ident)
on_gencase _ _ st = st
:: ConsInfo = {ci_cons_info :: DefinedSymbol, ci_field_infos :: [DefinedSymbol]}
buildGenericTypeRep ::
......@@ -329,11 +328,11 @@ buildGenericTypeRep type_index funs_and_groups
# (type_def, gs_modules) = gs_modules![type_index.gi_module].com_type_defs.[type_index.gi_index]
# (cons_infos, funs_and_groups, gs_modules, heaps, gs_error)
# (type_info, cons_infos, funs_and_groups, gs_modules, heaps, gs_error)
= buildTypeDefInfo type_index.gi_module type_def gs_main_module gs_predefs funs_and_groups gs_modules heaps gs_error
# (atype, (gs_modules, gs_td_infos, heaps, gs_error))
= buildStructType type_index cons_infos gs_predefs (gs_modules, gs_td_infos, heaps, gs_error)
= buildStructType type_index type_info cons_infos gs_predefs (gs_modules, gs_td_infos, heaps, gs_error)
# (from_fun_ds, funs_and_groups, heaps, gs_error)
= buildConversionFrom type_index.gi_module type_def gs_main_module gs_predefs funs_and_groups heaps gs_error
......@@ -375,10 +374,13 @@ where
convert {at_type=(CV tv) :@: args} st
#! (args, st) = mapSt convert args st
= (GTSAppVar tv args, st)
convert {at_type=x --> y} st
#! (x, st) = convert x st
#! (y, st) = convert y st
= (GTSAppCons (KindArrow [KindConst, KindConst]) [x,y], st)
//= (GTSAppCons (KindArrow [KindConst, KindConst]) [x,y], st)
= (GTSArrow x y, st)
convert {at_type=TV tv} st
= (GTSVar tv, st)
convert {at_type=TB _} st
......@@ -406,33 +408,100 @@ where
#! (args, st) = mapSt convert args (modules, td_infos, heaps, error)
-> (GTSAppCons kind args, st)
// the structure type of a genric type can often be simplified
// because bimaps for types not containing generic variables are indentity bimaps
simplifyStructOfGenType :: ![TypeVar] !GenTypeStruct !*Heaps -> (!GenTypeStruct, !*Heaps)
simplifyStructOfGenType gvars type heaps=:{hp_type_heaps=hp_type_heaps=:{th_vars}}
| True
#! th_vars = foldSt mark_type_var gvars th_vars
#! (type, th_vars) = simplify type th_vars
#! th_vars = foldSt clear_type_var gvars th_vars
= (type, { heaps & hp_type_heaps = { hp_type_heaps & th_vars = th_vars}})
| otherwise
= (type, heaps)
where
simplify t=:(GTSAppCons KindConst []) st
= (t, st)
simplify (GTSAppCons kind=:(KindArrow kinds) args) st
# formal_arity = length kinds
# actual_arity = length args
# (contains_gen_vars, st) = occurs_list args st
| formal_arity == actual_arity && not contains_gen_vars
= (GTSAppCons KindConst [], st)
| otherwise
# (args, st) = mapSt simplify args st
=(GTSAppCons kind args, st)
simplify (GTSArrow x y) st
# (x, st) = simplify x st
# (y, st) = simplify y st
= (GTSArrow x y, st)
simplify (GTSAppVar tv args) st
# (args, st) = mapSt simplify args st
= (GTSAppVar tv args, st)
simplify t=:(GTSVar tv) st
= (t, st)
simplify t st
= abort "invalid generic type structure\n"
//---> ("invalid generic type structure", t)
occurs (GTSAppCons _ args) st = occurs_list args st
occurs (GTSAppVar tv args) st = occurs_list [GTSVar tv: args] st
occurs (GTSVar tv) st = type_var_occurs tv st
occurs (GTSArrow x y) st = occurs_list [x,y] st
occurs (GTSCons _ arg) st = occurs arg st
occurs (GTSField _ arg) st = occurs arg st
occurs (GTSObject _ arg) st = occurs arg st
occurs GTSE st = (False, st)
occurs_list [] st = (False, st)
occurs_list [x:xs] st
# (x, st) = occurs x st
# (xs, st) = occurs_list xs st
= (x || xs, st)
type_var_occurs tv th_vars
# (tv_info, th_vars) = readPtr tv.tv_info_ptr th_vars
= case tv_info of
TVI_Empty = (False, th_vars)
TVI_Used = (True, th_vars)
_ = abort "invalid type var info"
---> ("type var is not empty", tv, tv_info)
mark_type_var tv=:{tv_info_ptr} th_vars
# (tv_info, th_vars) = readPtr tv_info_ptr th_vars
= case tv_info of
TVI_Empty = writePtr tv_info_ptr TVI_Used th_vars
_ = abort "type var is not empty"
---> ("type var is not empty", tv, tv_info)
clear_type_var {tv_info_ptr} th_vars
= writePtr tv_info_ptr TVI_Empty th_vars
buildStructType ::
!GlobalIndex // type def global index
!DefinedSymbol // type_info
![ConsInfo] // constructor and field info symbols
!PredefinedSymbols
(!*Modules, !*TypeDefInfos, !*Heaps, !*ErrorAdmin)
-> ( !GenTypeStruct // the structure type
, (!*Modules, !*TypeDefInfos, !*Heaps, !*ErrorAdmin)
)
buildStructType {gi_module,gi_index} cons_infos predefs (modules, td_infos, heaps, error)
buildStructType {gi_module,gi_index} type_info cons_infos predefs (modules, td_infos, heaps, error)
# (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)
= build_type type_def type_info cons_infos (modules, td_infos, heaps, error)
//---> ("buildStructureType", td_ident, atype)
where
build_type {td_rhs=AlgType alts, td_ident, td_pos} cons_infos st
build_type {td_rhs=AlgType alts, td_ident, td_pos} type_info cons_infos st
# (cons_args, st) = zipWithSt (build_alt td_ident td_pos) alts cons_infos st
= (build_sum_type cons_args, st)
# type = build_sum_type cons_args
# type = SwitchGenericInfo (GTSObject type_info type) type
= (type, 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_ident, td_pos}
[{ci_cons_info, ci_field_infos}]
type_info [{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_ident td_pos predefs) st_args (modules, td_infos, heaps, error)
......@@ -441,16 +510,17 @@ where
# prod_type = build_prod_type args
# type = SwitchGenericInfo (GTSCons ci_cons_info prod_type) prod_type
# type = SwitchGenericInfo (GTSObject type_info type) type
= (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_ident, td_pos} cons_infos (modules, td_infos, heaps, error)
build_type {td_rhs=SynType type,td_ident, td_pos} type_info 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_ident, td_arity, td_args, td_pos} cdis (modules, td_infos, heaps, error)
build_type td=:{td_rhs=(AbstractType _),td_ident, td_arity, td_args, td_pos} type_info 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))
......@@ -521,7 +591,8 @@ buildTypeDefInfo ::
!*Modules
!*Heaps
!*ErrorAdmin
-> ( ![ConsInfo]
-> ( DefinedSymbol // type info
, ![ConsInfo]
, !FunsAndGroups
, !*Modules
, !*Heaps
......@@ -582,6 +653,9 @@ buildTypeDefInfo1 td_module {td_ident, td_pos, td_arity} alts fields main_module
# funs_and_groups = (new_fun_index, new_group_index, new_funs, new_groups)
# (type_info_ds, (funs_and_groups, heaps))
= build_type_info type_def_dsc_ds (funs_and_groups, heaps)
# (cons_info_dss, (funs_and_groups, heaps))
= mapSt build_cons_info cons_dsc_dss (funs_and_groups, heaps)
......@@ -593,7 +667,8 @@ buildTypeDefInfo1 td_module {td_ident, td_pos, td_arity} alts fields main_module
(cons_info_dss, []) -> [{ci_cons_info=x,ci_field_infos=[]}\\x<-cons_info_dss]
_ -> abort "generics.icl sanity check: fields in non-record type\n"
= (cons_infos, funs_and_groups, modules, heaps, error)
= (type_info_ds, cons_infos, funs_and_groups, modules, heaps, error)
where
build_type_def_dsc group_index cons_info_dss {ds_index, ds_ident} heaps
......@@ -756,6 +831,19 @@ where
# (def_sym, funs_and_groups) = buildFunAndGroup ident [] body_expr No main_module_index td_pos funs_and_groups
= (def_sym, (funs_and_groups, heaps))
build_type_info type_dsc_ds (funs_and_groups, heaps)
# ident = makeIdent ("g"+++type_dsc_ds.ds_ident.id_name)
# (type_dsc_expr, heaps) = buildFunApp main_module_index type_dsc_ds [] heaps
# (body_expr, heaps)
= buildPredefConsApp PD_GenericTypeInfo [type_dsc_expr] predefs heaps
# (def_sym, funs_and_groups) = buildFunAndGroup ident [] body_expr No main_module_index td_pos funs_and_groups
= (def_sym, (funs_and_groups, heaps))
//========================================================================================
// conversions functions
//========================================================================================
......@@ -892,6 +980,10 @@ where
build_cons expr heaps = buildPredefConsApp PD_ConsCONS [expr] predefs heaps
#! (expr, heaps) = build_sum i n expr predefs heaps
#! (expr, heaps) = SwitchGenericInfo (build_object expr heaps) (expr, heaps)
with
build_object expr heaps = buildPredefConsApp PD_ConsOBJECT [expr] predefs heaps
#! alg_pattern = {
ap_symbol = {glob_module = type_def_mod, glob_object = cons_def_sym},
ap_vars = vars,
......@@ -975,9 +1067,18 @@ where
, !*ErrorAdmin
)
build_expr_for_type_rhs type_def_mod (AlgType def_symbols) heaps error
= build_sum False type_def_mod def_symbols heaps error
#! (expr, var, heaps, error) = build_sum False type_def_mod def_symbols heaps error
#! (expr, var, heaps) = SwitchGenericInfo
(build_case_object var expr heaps)
(expr, var, heaps)
= (expr, var, heaps, error)
build_expr_for_type_rhs type_def_mod (RecordType {rt_constructor}) heaps error
= build_sum True type_def_mod [rt_constructor] heaps error
# (expr, var, heaps, error) = build_sum True type_def_mod [rt_constructor] heaps error
#! (expr, var, heaps) = SwitchGenericInfo
(build_case_object var expr heaps)
(expr, var, heaps)
= (expr, var, heaps, error)
build_expr_for_type_rhs type_def_mod (AbstractType _) heaps error
#! 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}
......@@ -1090,10 +1191,10 @@ where
# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pat]
= build_case_expr case_patterns heaps
// REC case
build_case_rec var body_expr heaps
# pat = buildPredefConsPattern PD_ConsREC [var] body_expr predefs
# {pds_module, pds_def} = predefs.[PD_TypeREC]
// OBJECT case
build_case_object var body_expr heaps
# pat = buildPredefConsPattern PD_ConsOBJECT [var] body_expr predefs
# {pds_module, pds_def} = predefs.[PD_TypeOBJECT]
# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pat]
= build_case_expr case_patterns heaps
......@@ -2000,6 +2101,9 @@ where
#! (struct_gen_type, (modules, td_infos, heaps, error)) = convertATypeToGenTypeStruct
bimap_ident gc_pos predefs curried_gen_type (modules, td_infos, heaps, error)
#! (struct_gen_type, heaps) = simplifyStructOfGenType gen_vars struct_gen_type heaps
#! (bimap_expr, (td_infos, heaps, error))
= specializeGeneric {gi_module=bimap_module,gi_index=bimap_index} struct_gen_type spec_env bimap_ident gc_pos main_module_index predefs (td_infos, heaps, error)
......@@ -2291,6 +2395,10 @@ where
= (expr @ arg_exprs, st)
specialize (GTSVar tv) st
= specialize_type_var tv st
specialize (GTSArrow x y) st
#! (x, st) = specialize x st
#! (y, st) = specialize y st
= build_generic_app (KindArrow [KindConst, KindConst]) [x,y] st
specialize (GTSCons cons_info_ds arg_type) st
# (arg_expr, (td_infos, heaps, error)) = specialize arg_type st
......@@ -2314,6 +2422,16 @@ where
= (expr, (td_infos, heaps, error))
specialize (GTSObject type_info_ds arg_type) st
# (arg_expr, (td_infos, heaps, error)) = specialize arg_type st
#! (generic_info_expr, heaps) = buildFunApp main_module_index type_info_ds [] heaps
#! (expr, heaps) = buildGenericApp
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_ident gen_pos "cannot specialize " error
......@@ -2340,7 +2458,7 @@ where
//****************************************************************************************
// kind indexing:
// t_* a1 ... an = t a1 ... an
// t_{*} a1 ... an = t a1 ... an
// t_{k->l} a1 ... an = forall b1...bn.(t_k b1 ... bn) -> (t_l (a1 b1) ... (an bn))
buildKindIndexedType ::
!SymbolType // symbol type to kind-index
......@@ -2504,7 +2622,9 @@ where
build_body st gatvs arg_gatvss th
# th = clearSymbolType st th
# th = fold2St subst_gatv gatvs arg_gatvss th
= applySubstInSymbolType st th
# (st, th) = applySubstInSymbolType st th
//# st = add_propagating_inequalities st gatvs arg_gatvss
= (st, th)
where
subst_gatv gatv=:{atv_variable} arg_gatvs th=:{th_vars}
#! type_args = [ makeAType (TV atv_variable) atv_attribute
......@@ -2513,6 +2633,17 @@ where
#! th_vars = writePtr atv_variable.tv_info_ptr (TVI_Type type) th_vars
= {th & th_vars = th_vars}
add_propagating_inequalities st gatvs arg_gatvss
# inequalities = zipWith make_inequalities gatvs arg_gatvss
= {st & st_attr_env = st.st_attr_env ++ flatten inequalities}
where
make_inequalities gatv arg_gatvs
= filterOptionals (map (make_inequality gatv) arg_gatvs)
make_inequality {atv_attribute=TA_Var x} {atv_attribute=TA_Var y}
= Yes {ai_offered = x, ai_demanded = y} // offered <= demanded = outer<=inner = x<=y
make_inequality _ _
= No
reportError name pos msg error=:{ea_file}
//= checkErrorWithIdentPos (newPosition name pos) msg error
# ea_file = ea_file <<< "Error " <<< (newPosition name pos) <<< ":" <<< msg <<< '\n'
......@@ -3847,6 +3978,10 @@ mapOptionalSt f (Yes x) st
# (y, st) = f x st
= (Yes y, st)
filterOptionals [] = []
filterOptionals [No : xs] = filterOptionals xs
filterOptionals [Yes x : xs] = [x : filterOptionals xs]
mapSt2 f [] st1 st2 = ([], st1, st2)
mapSt2 f [x:xs] st1 st2
# (y, st1, st2) = f x st1 st2
......
......@@ -471,6 +471,7 @@ where
# (ident, pState) = stringToIdent name (IC_GenericCase type) pState
# (type_CONS_ident, pState) = stringToIdent "CONS" IC_Type pState
# (type_FIELD_ident, pState)= stringToIdent "FIELD" IC_Type pState
# (type_OBJECT_ident, pState)= stringToIdent "OBJECT" IC_Type pState
# (generic_ident, pState) = stringToIdent name IC_Generic pState
# (type_cons, pState) = get_type_cons type pState
......@@ -504,6 +505,9 @@ where
| type_ident == type_FIELD_ident
# (cons_FIELD_ident, pState) = stringToIdent "GenericFieldInfo" IC_Expression pState
-> (PE_List [PE_Ident cons_FIELD_ident, geninfo_arg], pState)
| type_ident == type_OBJECT_ident
# (cons_OBJECT_ident, pState) = stringToIdent "GenericTypeDefInfo" IC_Expression pState
-> (PE_List [PE_Ident cons_OBJECT_ident, geninfo_arg], pState)
_
| otherwise
-> (geninfo_arg, pState)
......
......@@ -189,65 +189,66 @@ PD_TypeCONS :== 206
PD_ConsCONS :== 207
PD_TypeFIELD :== 208
PD_ConsFIELD :== 209
PD_TypeREC :== 210
PD_ConsREC :== 211
PD_TypeOBJECT :== 210
PD_ConsOBJECT :== 211
PD_GenericInfo :== 212
PD_NoGenericInfo :== 213
PD_GenericConsInfo :== 214
PD_GenericFieldInfo :== 215
PD_TGenericConsDescriptor :== 216
PD_CGenericConsDescriptor :== 217
PD_TGenericFieldDescriptor :== 218
PD_CGenericFieldDescriptor :== 219
PD_TGenericTypeDefDescriptor :== 220
PD_CGenericTypeDefDescriptor :== 221
PD_TGenConsPrio :== 222
PD_CGenConsNoPrio :== 223
PD_CGenConsPrio :== 224
PD_TGenConsAssoc :== 225
PD_CGenConsAssocNone :== 226
PD_CGenConsAssocLeft :== 227
PD_CGenConsAssocRight :== 228
PD_TGenType :== 229
PD_CGenTypeCons :== 230
PD_CGenTypeVar :== 231
PD_CGenTypeArrow :== 232
PD_CGenTypeApp :== 233
PD_GenericBimap :== 234
PD_bimapId :== 235
PD_TypeGenericDict :== 236
PD_FromS :== 237
PD_FromTS :== 238
PD_FromSTS :== 239
PD_FromU :== 240
PD_FromUTS :== 241
PD_FromO :== 242
PD_FromThenS :== 243
PD_FromThenTS :== 244
PD_FromThenSTS :== 245
PD_FromThenU :== 246
PD_FromThenUTS :== 247
PD_FromThenO :== 248
PD_FromToS :== 249
PD_FromToTS :== 250
PD_FromToSTS :== 251
PD_FromToU :== 252
PD_FromToUTS :== 253
PD_FromToO :== 254
PD_FromThenToS :== 255
PD_FromThenToTS :== 256
PD_FromThenToSTS :== 257
PD_FromThenToU :== 258
PD_FromThenToUTS :== 259
PD_FromThenToO :== 260
PD_NrOfPredefSymbols :== 261
PD_GenericTypeInfo :== 216
PD_TGenericConsDescriptor :== 217
PD_CGenericConsDescriptor :== 218
PD_TGenericFieldDescriptor :== 219
PD_CGenericFieldDescriptor :== 220
PD_TGenericTypeDefDescriptor :== 221
PD_CGenericTypeDefDescriptor :== 222
PD_TGenConsPrio :== 223
PD_CGenConsNoPrio :== 224
PD_CGenConsPrio :== 225
PD_TGenConsAssoc :== 226
PD_CGenConsAssocNone :== 227
PD_CGenConsAssocLeft :== 228
PD_CGenConsAssocRight :== 229
PD_TGenType :== 230
PD_CGenTypeCons :== 231
PD_CGenTypeVar :== 232
PD_CGenTypeArrow :== 233
PD_CGenTypeApp :== 234
PD_GenericBimap :== 235
PD_bimapId :== 236
PD_TypeGenericDict :== 237
PD_FromS :== 238
PD_FromTS :== 239
PD_FromSTS :== 240
PD_FromU :== 241
PD_FromUTS :== 242
PD_FromO :== 243
PD_FromThenS :== 244
PD_FromThenTS :== 245
PD_FromThenSTS :== 246
PD_FromThenU :== 247
PD_FromThenUTS :== 248
PD_FromThenO :== 249
PD_FromToS :== 250
PD_FromToTS :== 251
PD_FromToSTS :== 252
PD_FromToU :== 253
PD_FromToUTS :== 254
PD_FromToO :== 255
PD_FromThenToS :== 256
PD_FromThenToTS :== 257
PD_FromThenToSTS :== 258
PD_FromThenToU :== 259
PD_FromThenToUTS :== 260
PD_FromThenToO :== 261
PD_NrOfPredefSymbols :== 262
GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2
GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2
......
......@@ -148,12 +148,13 @@ predefined_idents
[PD_ConsCONS] = i "CONS",
[PD_TypeFIELD] = i "FIELD",
[PD_ConsFIELD] = i "FIELD",
[PD_TypeREC] = i "REC",
[PD_ConsREC] = i "REC",
[PD_TypeOBJECT] = i "OBJECT",
[PD_ConsOBJECT] = i "OBJECT",
[PD_GenericInfo] = i "GenericInfo",
[PD_NoGenericInfo] = i "NoGenericInfo",
[PD_GenericConsInfo] = i "GenericConsInfo",
[PD_GenericFieldInfo] = i "GenericFieldInfo",
[PD_GenericTypeInfo] = i "GenericTypeDefInfo",
[PD_TGenericConsDescriptor] = i "GenericConsDescriptor",
[PD_CGenericConsDescriptor] = i "_GenericConsDescriptor",
[PD_TGenericFieldDescriptor] = i "GenericFieldDescriptor",
......@@ -376,13 +377,14 @@ where
<<- (local_predefined_idents, IC_Type, PD_TypeCONS)
<<- (local_predefined_idents, IC_Expression, PD_ConsCONS)
<<- (local_predefined_idents, IC_Type, PD_TypeFIELD)
<<- (local_predefined_idents, IC_Expression, PD_ConsREC)
<<- (local_predefined_idents, IC_Type, PD_TypeREC)
<<- (local_predefined_idents, IC_Expression, PD_ConsFIELD)
<<- (local_predefined_idents, IC_Type, PD_TypeOBJECT)
<<- (local_predefined_idents, IC_Expression, PD_ConsOBJECT)
<<- (local_predefined_idents, IC_Type, PD_GenericInfo)
<<- (local_predefined_idents, IC_Expression, PD_NoGenericInfo)
<<- (local_predefined_idents, IC_Expression, PD_GenericConsInfo)
<<- (local_predefined_idents, IC_Expression, PD_GenericFieldInfo)
<<- (local_predefined_idents, IC_Expression, PD_GenericTypeInfo)
<<- (local_predefined_idents, IC_Type, PD_TGenericConsDescriptor)
<<- (local_predefined_idents, IC_Expression, PD_CGenericConsDescriptor)
<<- (local_predefined_idents, IC_Type, PD_TGenericFieldDescriptor)
......
......@@ -463,9 +463,10 @@ NoGlobalIndex :== {gi_module=NoIndex,gi_index=NoIndex}
= GTSAppCons TypeKind [GenTypeStruct]
| GTSAppVar TypeVar [GenTypeStruct]
| GTSVar TypeVar
| GTSArrow GenTypeStruct GenTypeStruct // needed for simplifying bimaps
| GTSCons DefinedSymbol GenTypeStruct
| GTSField DefinedSymbol GenTypeStruct
| GTSRec GenTypeStruct
| GTSObject DefinedSymbol GenTypeStruct
| GTSE
:: GenericTypeRep =
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment