Commit 7a3e3a39 authored by Artem Alimarine's avatar Artem Alimarine
Browse files

Generics are added, but are disabled.

Tested with compiling Object IO and butstrapping.
parent fe32f6bc
...@@ -4,4 +4,3 @@ import checksupport, typesupport ...@@ -4,4 +4,3 @@ import checksupport, typesupport
analTypeDefs :: !{#CommonDefs} !NumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin) analTypeDefs :: !{#CommonDefs} !NumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
instance <<< TypeKind
...@@ -10,21 +10,6 @@ import syntax, checksupport, checktypes, check, typesupport, utilities, analunit ...@@ -10,21 +10,6 @@ import syntax, checksupport, checktypes, check, typesupport, utilities, analunit
AS_NotChecked :== -1 AS_NotChecked :== -1
instance <<< TypeKind
where
(<<<) file tk = file <<< toString (toKindInfo tk)
instance toString KindInfo
where
toString (KI_Var ptr) = "*" +++ toString (ptrToInt ptr)
toString (KI_Const) = "*"
toString (KI_Arrow kinds) = kind_list_to_string kinds
where
kind_list_to_string [] = " ?????? "
kind_list_to_string [k] = "* -> *"
kind_list_to_string [k:ks] = "* -> " +++ kind_list_to_string ks
kindError kind1 kind2 error kindError kind1 kind2 error
= checkError "conflicting kinds: " (toString kind1 +++ " and " +++ toString kind2) error = checkError "conflicting kinds: " (toString kind1 +++ " and " +++ toString kind2) error
...@@ -70,8 +55,8 @@ where ...@@ -70,8 +55,8 @@ where
= KI_Var info_ptr = KI_Var info_ptr
toKindInfo KindConst toKindInfo KindConst
= KI_Const = KI_Const
toKindInfo (KindArrow arity) toKindInfo (KindArrow ks)
= KI_Arrow [ KI_Const \\ i <- [1 .. arity]] = KI_Arrow [ toKindInfo k \\ k <- ks]
// ---> ("toKindInfo", arity) // ---> ("toKindInfo", arity)
...@@ -373,7 +358,8 @@ where ...@@ -373,7 +358,8 @@ where
determine_kind (KI_Indirection kind) determine_kind (KI_Indirection kind)
= determine_kind kind = determine_kind kind
determine_kind (KI_Arrow kinds) determine_kind (KI_Arrow kinds)
= KindArrow (length kinds) //AA: = KindArrow (length kinds)
= KindArrow [determine_kind k \\ k <- kinds]
determine_kind kind determine_kind kind
= KindConst = KindConst
......
...@@ -14,3 +14,5 @@ determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials ...@@ -14,3 +14,5 @@ determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials
arrayFunOffsetToPD_IndexTable :: !w:{# MemberDef} !v:{# PredefinedSymbol} -> (!{# Index}, !x:{#MemberDef}, !v:{#PredefinedSymbol}) , [w<=x] arrayFunOffsetToPD_IndexTable :: !w:{# MemberDef} !v:{# PredefinedSymbol} -> (!{# Index}, !x:{#MemberDef}, !v:{#PredefinedSymbol}) , [w<=x]
makeElemTypeOfArrayFunctionStrict :: !SymbolType !Index !{# Index} -> SymbolType makeElemTypeOfArrayFunctionStrict :: !SymbolType !Index !{# Index} -> SymbolType
initializeContextVariables :: ![TypeContext] !*VarHeap -> (![TypeContext], !*VarHeap)
This diff is collapsed.
...@@ -860,9 +860,39 @@ where ...@@ -860,9 +860,39 @@ where
checkExpression free_vars (PE_Ident id) e_input e_state e_info cs checkExpression free_vars (PE_Ident id) e_input e_state e_info cs
= checkIdentExpression cIsNotInExpressionList free_vars id e_input e_state e_info cs = checkIdentExpression cIsNotInExpressionList free_vars id e_input e_state e_info cs
// AA..
checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_state e_info cs=:{cs_symbol_table, cs_x}
//= checkIdentExpression cIsNotInExpressionList free_vars id e_input e_state e_info cs
# (entry, cs_symbol_table) = readPtr id_info cs_symbol_table
= check_generic_expr free_vars entry id kind e_input e_state e_info {cs & cs_symbol_table = cs_symbol_table}
where
check_generic_expr :: ![FreeVar] !SymbolTableEntry !Ident !TypeKind !ExpressionInput !*ExpressionState !*ExpressionInfo !*CheckState
-> (!Expression, ![FreeVar], !*ExpressionState, !*ExpressionInfo, !*CheckState)
check_generic_expr
free_vars entry=:{ste_kind=STE_Generic,ste_index} id kind
e_input=:{ei_mod_index} e_state e_info cs
= check_it free_vars ei_mod_index ste_index id kind e_input e_state e_info cs
check_generic_expr
free_vars entry=:{ste_kind=STE_Imported STE_Generic mod_index, ste_index} id kind
e_input e_state e_info cs
= check_it free_vars mod_index ste_index id kind e_input e_state e_info cs
check_generic_expr free_vars entry=:{ste_kind=STE_Empty} id kind e_input e_state e_info cs=:{cs_error}
= (EE, free_vars, e_state, e_info, { cs & cs_error = checkError id "undefined generic" cs_error })
check_generic_expr free_vars entry id kind e_input e_state e_info cs=:{cs_error}
= (EE, free_vars, e_state, e_info, { cs & cs_error = checkError id "not a generic" cs_error })
check_it free_vars mod_index gen_index id kind e_input e_state=:{es_expr_heap} e_info cs
#! symb_kind = SK_Generic { glob_object = gen_index, glob_module = mod_index} kind
#! symbol = { symb_name = id, symb_kind = symb_kind, symb_arity = 0 }
#! (new_info_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
#! app = { app_symb = symbol, app_args = [], app_info_ptr = new_info_ptr }
#! e_state = { e_state & es_expr_heap = es_expr_heap }
#! cs = { cs & cs_x.x_needed_modules = cs_x.x_needed_modules bitor cNeedStdGeneric }
= (App app, free_vars, e_state, e_info, cs)
// ..AA
checkExpression free_vars expr e_input e_state e_info cs checkExpression free_vars expr e_input e_state e_info cs
= abort "checkExpression (check.icl, line 1433)" // <<- expr = abort "checkExpression (checkFunctionBodies.icl, line 868)" // <<- expr
checkIdentExpression :: !Bool ![FreeVar] !Ident !ExpressionInput !*ExpressionState !u:ExpressionInfo !*CheckState checkIdentExpression :: !Bool ![FreeVar] !Ident !ExpressionInput !*ExpressionState !u:ExpressionInfo !*CheckState
......
...@@ -15,6 +15,7 @@ cIsADclModule :== True ...@@ -15,6 +15,7 @@ cIsADclModule :== True
cNeedStdArray :== 1 cNeedStdArray :== 1
cNeedStdEnum :== 2 cNeedStdEnum :== 2
cNeedStdDynamics:== 4 cNeedStdDynamics:== 4
cNeedStdGeneric :== 8 // AA
:: VarHeap :== Heap VarInfo :: VarHeap :== Heap VarInfo
...@@ -41,11 +42,12 @@ cConstructorDefs :== 1 ...@@ -41,11 +42,12 @@ cConstructorDefs :== 1
cSelectorDefs :== 2 cSelectorDefs :== 2
cClassDefs :== 3 cClassDefs :== 3
cMemberDefs :== 4 cMemberDefs :== 4
cInstanceDefs :== 5 cGenericDefs :== 5 // AA
cFunctionDefs :== 6 cInstanceDefs :== 6
cMacroDefs :== 7 cFunctionDefs :== 7
cMacroDefs :== 8
cConversionTableSize :== 8 cConversionTableSize :== 9 // AA
:: CommonDefs = :: CommonDefs =
{ com_type_defs :: !.{# CheckedTypeDef} { com_type_defs :: !.{# CheckedTypeDef}
...@@ -55,6 +57,7 @@ cConversionTableSize :== 8 ...@@ -55,6 +57,7 @@ cConversionTableSize :== 8
, com_member_defs :: !.{# MemberDef} , com_member_defs :: !.{# MemberDef}
, com_instance_defs :: !.{# ClassInstance} , com_instance_defs :: !.{# ClassInstance}
// , com_instance_types :: !.{ SymbolType} // , com_instance_types :: !.{ SymbolType}
, com_generic_defs :: !.{# GenericDef} // AA
} }
:: Declarations = { :: Declarations = {
...@@ -135,6 +138,7 @@ instance <<< IdentPos, ExplImpInfo, DeclarationInfo ...@@ -135,6 +138,7 @@ instance <<< IdentPos, ExplImpInfo, DeclarationInfo
, ef_cons_defs :: !.{# ConsDef} , ef_cons_defs :: !.{# ConsDef}
, ef_member_defs :: !.{# MemberDef} , ef_member_defs :: !.{# MemberDef}
, ef_class_defs :: !.{# ClassDef} , ef_class_defs :: !.{# ClassDef}
, ef_generic_defs :: !.{# GenericDef} // AA
, ef_modules :: !.{# DclModule} , ef_modules :: !.{# DclModule}
, ef_is_macro_fun :: !Bool , ef_is_macro_fun :: !Bool
} }
......
...@@ -22,6 +22,7 @@ cIsADclModule :== True ...@@ -22,6 +22,7 @@ cIsADclModule :== True
cNeedStdArray :== 1 cNeedStdArray :== 1
cNeedStdEnum :== 2 cNeedStdEnum :== 2
cNeedStdDynamics:== 4 cNeedStdDynamics:== 4
cNeedStdGeneric :== 8 // AA
:: Heaps = :: Heaps =
{ hp_var_heap ::!.VarHeap { hp_var_heap ::!.VarHeap
...@@ -42,11 +43,12 @@ cConstructorDefs :== 1 ...@@ -42,11 +43,12 @@ cConstructorDefs :== 1
cSelectorDefs :== 2 cSelectorDefs :== 2
cClassDefs :== 3 cClassDefs :== 3
cMemberDefs :== 4 cMemberDefs :== 4
cInstanceDefs :== 5 cGenericDefs :== 5 // AA
cFunctionDefs :== 6 cInstanceDefs :== 6
cMacroDefs :== 7 cFunctionDefs :== 7
cMacroDefs :== 8
cConversionTableSize :== 8 cConversionTableSize :== 9 // AA
instance toInt STE_Kind instance toInt STE_Kind
where where
...@@ -54,8 +56,9 @@ where ...@@ -54,8 +56,9 @@ where
toInt STE_Constructor = cConstructorDefs toInt STE_Constructor = cConstructorDefs
toInt (STE_Field _) = cSelectorDefs toInt (STE_Field _) = cSelectorDefs
toInt STE_Class = cClassDefs toInt STE_Class = cClassDefs
toInt STE_Generic = cGenericDefs
toInt STE_Member = cMemberDefs toInt STE_Member = cMemberDefs
toInt (STE_Instance _) = cInstanceDefs toInt (STE_Instance _) = cInstanceDefs
toInt STE_DclFunction = cFunctionDefs toInt STE_DclFunction = cFunctionDefs
toInt (STE_FunctionOrMacro _) = cMacroDefs toInt (STE_FunctionOrMacro _) = cMacroDefs
toInt _ = NoIndex toInt _ = NoIndex
...@@ -67,6 +70,7 @@ where ...@@ -67,6 +70,7 @@ where
, com_class_defs :: !.{# ClassDef} , com_class_defs :: !.{# ClassDef}
, com_member_defs :: !.{# MemberDef} , com_member_defs :: !.{# MemberDef}
, com_instance_defs :: !.{# ClassInstance} , com_instance_defs :: !.{# ClassInstance}
, com_generic_defs :: !.{# GenericDef} // AA
} }
:: Declarations = { :: Declarations = {
...@@ -206,6 +210,7 @@ where ...@@ -206,6 +210,7 @@ where
, ef_cons_defs :: !.{# ConsDef} , ef_cons_defs :: !.{# ConsDef}
, ef_member_defs :: !.{# MemberDef} , ef_member_defs :: !.{# MemberDef}
, ef_class_defs :: !.{# ClassDef} , ef_class_defs :: !.{# ClassDef}
, ef_generic_defs :: !.{# GenericDef} // AA
, ef_modules :: !.{# DclModule} , ef_modules :: !.{# DclModule}
, ef_is_macro_fun :: !Bool , ef_is_macro_fun :: !Bool
} }
......
...@@ -29,3 +29,5 @@ decodeTopConsVar cv :== ~(inc cv) ...@@ -29,3 +29,5 @@ decodeTopConsVar cv :== ~(inc cv)
expandSynonymTypes :: !.Index !*{#CheckedTypeDef} !*{#.DclModule} !*TypeHeaps !*ErrorAdmin expandSynonymTypes :: !.Index !*{#CheckedTypeDef} !*{#.DclModule} !*TypeHeaps !*ErrorAdmin
-> (!.{#CheckedTypeDef},!.{#DclModule},!.TypeHeaps,!.ErrorAdmin) -> (!.{#CheckedTypeDef},!.{#DclModule},!.TypeHeaps,!.ErrorAdmin)
removeVariablesFromSymbolTable :: !Int ![TypeVar] !*SymbolTable -> *SymbolTable
...@@ -400,25 +400,6 @@ expandSynType mod_index type_index expst=:{exp_type_defs} ...@@ -400,25 +400,6 @@ expandSynType mod_index type_index expst=:{exp_type_defs}
_ _
-> { expst & exp_marks = { expst.exp_marks & [type_index] = CS_Checked }} -> { expst & exp_marks = { expst.exp_marks & [type_index] = CS_Checked }}
instance toString KindInfo
where
toString (KI_Var ptr) = "*" +++ toString (ptrToInt ptr)
toString (KI_Const) = "*"
toString (KI_Arrow kinds) = kind_list_to_string kinds
where
kind_list_to_string [k] = "* -> *"
kind_list_to_string [k:ks] = "* -> " +++ kind_list_to_string ks
/*
instance toString TypeKind
where
toString (KindVar var_num) = "*" +++ toString var_num
toString (KindConst) = "*"
toString (KindArrow [k:ks]) = toString k +++ kind_list_to_string ks +++ " -> *"
where
kind_list_to_string [] = ""
kind_list_to_string [k:ks] = " -> " +++ toString k +++ kind_list_to_string ks
*/
checkTypeDefs :: /* TD */ !Bool !Bool !*{# CheckedTypeDef} !Index !*{# ConsDef} !*{# SelectorDef} !*{# DclModule} !*VarHeap !*TypeHeaps !*CheckState checkTypeDefs :: /* TD */ !Bool !Bool !*{# CheckedTypeDef} !Index !*{# ConsDef} !*{# SelectorDef} !*{# DclModule} !*VarHeap !*TypeHeaps !*CheckState
-> (!*{# CheckedTypeDef}, !*{# ConsDef}, !*{# SelectorDef}, !*{# DclModule}, !*VarHeap, !*TypeHeaps, !*CheckState) -> (!*{# CheckedTypeDef}, !*{# ConsDef}, !*{# SelectorDef}, !*{# DclModule}, !*VarHeap, !*TypeHeaps, !*CheckState)
checkTypeDefs /* TD */ is_dcl_module is_main_dcl type_defs module_index cons_defs selector_defs modules var_heap type_heaps cs checkTypeDefs /* TD */ is_dcl_module is_main_dcl type_defs module_index cons_defs selector_defs modules var_heap type_heaps cs
...@@ -1171,6 +1152,8 @@ where ...@@ -1171,6 +1152,8 @@ where
= create_class_dictionaries mod_index (inc class_index) class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs = create_class_dictionaries mod_index (inc class_index) class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs
= (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs) = (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs)
create_class_dictionary :: !Index !Index !*{#ClassDef} !w:{#DclModule} !v:[SymbolPtr] !u:Indexes !*TypeVarHeap !*VarHeap !*CheckState
-> (!*{#ClassDef}, !w:{#DclModule}, !v:[SymbolPtr], !u:Indexes, !*TypeVarHeap, !*VarHeap, !*CheckState)
create_class_dictionary mod_index class_index class_defs =:{[class_index] = class_def } modules rev_dictionary_list create_class_dictionary mod_index class_index class_defs =:{[class_index] = class_def } modules rev_dictionary_list
indexes type_var_heap var_heap cs=:{cs_symbol_table,cs_error} indexes type_var_heap var_heap cs=:{cs_symbol_table,cs_error}
# {class_name,class_args,class_arity,class_members,class_context,class_dictionary=ds=:{ds_ident={id_info}}} = class_def # {class_name,class_args,class_arity,class_members,class_context,class_dictionary=ds=:{ds_ident={id_info}}} = class_def
...@@ -1241,6 +1224,7 @@ where ...@@ -1241,6 +1224,7 @@ where
ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" }) ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" })
<:= (cons_id_info, { ste_kind = STE_DictCons cons_def, ste_index = index_cons, <:= (cons_id_info, { ste_kind = STE_DictCons cons_def, ste_index = index_cons,
ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" })}) ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" })})
# ({ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table # ({ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table
| ste_kind == STE_Empty | ste_kind == STE_Empty
= (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, = (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap,
......
...@@ -547,6 +547,7 @@ instance toString STE_Kind where ...@@ -547,6 +547,7 @@ instance toString STE_Kind where
toString STE_Constructor = "constructor" toString STE_Constructor = "constructor"
toString (STE_Field _) = "field" toString (STE_Field _) = "field"
toString STE_Class = "class" toString STE_Class = "class"
toString STE_Generic = "generic" //AA
toString STE_Member = "class member" toString STE_Member = "class member"
toString (STE_Instance _) = "instance" toString (STE_Instance _) = "instance"
...@@ -623,7 +624,7 @@ instance check_completeness CheckedBody where ...@@ -623,7 +624,7 @@ instance check_completeness CheckedBody where
instance check_completeness ClassDef where instance check_completeness ClassDef where
check_completeness {class_context} cci ccs check_completeness {class_context} cci ccs
= check_completeness class_context cci ccs = check_completeness class_context cci ccs
instance check_completeness ClassInstance where instance check_completeness ClassInstance where
check_completeness {ins_class, ins_type} cci ccs check_completeness {ins_class, ins_type} cci ccs
= check_completeness ins_type cci = check_completeness ins_type cci
......
...@@ -2,6 +2,8 @@ implementation module frontend ...@@ -2,6 +2,8 @@ implementation module frontend
import scanner, parse, postparse, check, type, trans, convertcases, overloading, utilities, convertDynamics import scanner, parse, postparse, check, type, trans, convertcases, overloading, utilities, convertDynamics
//import RWSDebug //import RWSDebug
import analtypes
import generics
:: FrontEndSyntaxTree :: FrontEndSyntaxTree
= { fe_icl :: !IclModule = { fe_icl :: !IclModule
...@@ -121,17 +123,37 @@ frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_mac ...@@ -121,17 +123,37 @@ frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_mac
| upToPhase == FrontEndPhaseCheck | upToPhase == FrontEndPhaseCheck
= frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps = frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps
// AA..
# error_admin = {ea_file = error, ea_loc = [], ea_ok = True }
# ti_common_defs = {{dcl_common \\ {dcl_common} <-: dcl_mods } & [main_dcl_module_n] = icl_common }
# (td_infos, type_heaps, error_admin) = analTypeDefs ti_common_defs icl_used_module_numbers type_heaps error_admin
# heaps = { heaps & hp_type_heaps = type_heaps }
#! (components, ti_common_defs, fun_defs, generic_range, td_infos, heaps, hash_table, predef_symbols, dcl_mods, error_admin) =
case False of
True -> convertGenerics
components main_dcl_module_n ti_common_defs fun_defs td_infos
heaps hash_table predef_symbols dcl_mods error_admin
False -> (components, ti_common_defs, fun_defs, {ir_to=0,ir_from=0}, td_infos, heaps, hash_table, predef_symbols, dcl_mods, error_admin)
# icl_common = ti_common_defs.[main_dcl_module_n]
# error = error_admin.ea_file
// ..AA
# (ok, fun_defs, array_instances, type_code_instances, common_defs, imported_funs, type_def_infos, heaps, predef_symbols, error,out) # (ok, fun_defs, array_instances, type_code_instances, common_defs, imported_funs, type_def_infos, heaps, predef_symbols, error,out)
= typeProgram (components -*-> "Typing") main_dcl_module_n icl_functions icl_specials list_inferred_types icl_common [a\\a<-:icl_import] dcl_mods icl_used_module_numbers heaps predef_symbols error out dcl_mods = typeProgram (components -*-> "Typing") main_dcl_module_n fun_defs/*icl_functions*/ icl_specials list_inferred_types icl_common [a\\a<-:icl_import] dcl_mods icl_used_module_numbers td_infos heaps predef_symbols error out dcl_mods
| not ok | not ok
= (No,{},0,main_dcl_module_n,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps) = (No,{},0,main_dcl_module_n,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
# (components, fun_defs) = partitionateFunctions (fun_defs -*-> "partitionateFunctions") [ global_fun_range, icl_instances, icl_specials] # (fun_def_size, fun_defs) = usize fun_defs
# (components, fun_defs) = partitionateFunctions (fun_defs -*-> "partitionateFunctions") [ global_fun_range, icl_instances, icl_specials, generic_range]
// (components, fun_defs, error) = showTypes components 0 fun_defs error // (components, fun_defs, error) = showTypes components 0 fun_defs error
// (components, fun_defs, error) = showComponents components 0 True fun_defs error // (components, fun_defs, error) = showComponents components 0 True fun_defs error
// (fun_defs, error) = showFunctions array_instances fun_defs error // (fun_defs, error) = showFunctions array_instances fun_defs error
| upToPhase == FrontEndPhaseTypeCheck | upToPhase == FrontEndPhaseTypeCheck
= frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps = frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps
...@@ -242,8 +264,7 @@ where ...@@ -242,8 +264,7 @@ where
= 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.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)
// = show_component funs show_types fun_defs (file <<< fun_def.fun_symb) // = show_component funs show_types fun_defs (file <<< fun_def.fun_symb)
showComponents2 :: !{! Group} !Int !*{# FunDef} !{! ConsClasses} !*File -> (!*{# FunDef},!*File) showComponents2 :: !{! Group} !Int !*{# FunDef} !{! ConsClasses} !*File -> (!*{# FunDef},!*File)
showComponents2 comps comp_index fun_defs acc_args file showComponents2 comps comp_index fun_defs acc_args file
| comp_index >= (size comps) | comp_index >= (size comps)
......
definition module generics
import checksupport
from transform import Group
convertGenerics :: !{!Group} !Int !{#CommonDefs} !*{# FunDef} !*TypeDefInfos !*Heaps !*HashTable !*PredefinedSymbols !u:{# DclModule} !*ErrorAdmin
-> (!{!Group}, !{#CommonDefs}, !*{# FunDef}, !IndexRange, !*TypeDefInfos, !*Heaps, !*HashTable, !*PredefinedSymbols, !u:{# DclModule}, !*ErrorAdmin)
getGenericMember :: !(Global Index) !TypeKind !{#CommonDefs} -> (Bool, Global Index)
\ No newline at end of file
This diff is collapsed.
...@@ -3,6 +3,7 @@ implementation module overloading ...@@ -3,6 +3,7 @@ implementation module overloading
import StdEnv import StdEnv
import syntax, check, type, typesupport, utilities, unitype, predef, checktypes, convertDynamics // ,RWSDebug import syntax, check, type, typesupport, utilities, unitype, predef, checktypes, convertDynamics // ,RWSDebug
import generics // AA
:: InstanceTree = IT_Node !(Global Index) !InstanceTree !InstanceTree | IT_Empty :: InstanceTree = IT_Node !(Global Index) !InstanceTree !InstanceTree | IT_Empty
...@@ -711,6 +712,13 @@ where ...@@ -711,6 +712,13 @@ where
= find_instance_of_member me_class me_offset {rcs & rcs_constraints_contexts = rcs_constraints_contexts ++ rcss} = find_instance_of_member me_class me_offset {rcs & rcs_constraints_contexts = rcs_constraints_contexts ++ rcss}
find_instance_of_member_in_constraints me_class me_offset [] find_instance_of_member_in_constraints me_class me_offset []
= abort "Error in module overloading: find_instance_of_member_in_constraints\n" = abort "Error in module overloading: find_instance_of_member_in_constraints\n"
// AA..
convertOverloadedCall defs contexts symbol=:{symb_kind = SK_Generic gen_glob kind} expr_ptr class_appls heaps_and_ptrs
# (found, member_glob) = getGenericMember gen_glob kind defs
| not found
= abort "convertOverloadedCall: no class for kind"
= convertOverloadedCall defs contexts {symbol & symb_kind = SK_OverloadedFunction member_glob} expr_ptr class_appls heaps_and_ptrs
// ..AA
convertOverloadedCall defs contexts {symb_name,symb_kind = SK_TypeCode} expr_info_ptr class_appls heaps_and_ptrs convertOverloadedCall defs contexts {symb_name,symb_kind = SK_TypeCode} expr_info_ptr class_appls heaps_and_ptrs
# (class_expressions, (heaps, ptrs)) = convertClassApplsToExpressions defs contexts class_appls heaps_and_ptrs # (class_expressions, (heaps, ptrs)) = convertClassApplsToExpressions defs contexts class_appls heaps_and_ptrs
= ({ heaps & hp_expression_heap = heaps.hp_expression_heap <:= (expr_info_ptr, EI_TypeCodes (map expressionToTypeCodeExpression class_expressions))}, ptrs) = ({ heaps & hp_expression_heap = heaps.hp_expression_heap <:= (expr_info_ptr, EI_TypeCodes (map expressionToTypeCodeExpression class_expressions))}, ptrs)
...@@ -868,7 +876,6 @@ getClassVariable symb var_info_ptr var_heap error ...@@ -868,7 +876,6 @@ getClassVariable symb var_info_ptr var_heap error
(_, var_heap) (_, var_heap)
-> (symb, var_info_ptr, var_heap, overloadingError symb error) -> (symb, var_info_ptr, var_heap, overloadingError symb error)
updateDynamics :: ![Index] ![LocalTypePatternVariable] !Int !*{#FunDef} !*{! FunctionType} !*ExpressionHeap !*TypeCodeInfo !*VarHeap !*ErrorAdmin !*{#PredefinedSymbol} updateDynamics :: ![Index] ![LocalTypePatternVariable] !Int !*{#FunDef} !*{! FunctionType} !*ExpressionHeap !*TypeCodeInfo !*VarHeap !*ErrorAdmin !*{#PredefinedSymbol}
-> (!*{#FunDef}, !*{! FunctionType}, !*ExpressionHeap, !*TypeCodeInfo, !*VarHeap, !*ErrorAdmin, !*{#PredefinedSymbol}) -> (!*{#FunDef}, !*{! FunctionType}, !*ExpressionHeap, !*TypeCodeInfo, !*VarHeap, !*ErrorAdmin, !*{#PredefinedSymbol})
updateDynamics funs type_pattern_vars main_dcl_module_n fun_defs fun_env symbol_heap type_code_info var_heap error predef_symbols updateDynamics funs type_pattern_vars main_dcl_module_n fun_defs fun_env symbol_heap type_code_info var_heap error predef_symbols
......
...@@ -287,7 +287,7 @@ where ...@@ -287,7 +287,7 @@ where
(defs, pState) = want_definitions (SetGlobalContext iclmodule) pState (defs, pState) = want_definitions (SetGlobalContext iclmodule) pState
{ps_scanState,ps_hash_table,ps_error,ps_pre_def_symbols} {ps_scanState,ps_hash_table,ps_error,ps_pre_def_symbols}
= pState = pState
defs = if (ParseOnly && id_name <> "StdOverloaded" && id_name <> "StdArray" && id_name <> "StdEnum" && id_name <> "StdBool" && id_name <> "StdDynamics") 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] [PD_Import imports \\ PD_Import imports <- defs]
defs defs
mod = { mod_name = mod_ident, mod_type = mod_type, mod_imports = [], mod_imported_objects = [], mod_defs = defs } mod = { mod_name = mod_ident, mod_type = mod_type, mod_imports = [], mod_imported_objects = [], mod_defs = defs }
...@@ -413,6 +413,13 @@ where ...@@ -413,6 +413,13 @@ where
= (False,abort "no def(2)",parseError "definition" No "class definitions are only at the global level" pState) = (False,abort "no def(2)",parseError "definition" No "class definitions are only at the global level" pState)
# (classdef, pState) = wantClassDefinition context pos pState # (classdef, pState) = wantClassDefinition context pos pState
= (True, classdef, pState) = (True, classdef, pState)
// AA..
try_definition context GenericToken pos pState
| ~(isGlobalContext context)
= (False,abort "no def(2)",parseError "definition" No "generic definitions are only at the global level" pState)
# (gendef, pState) = wantGenericDefinition context pos pState
= (True, gendef, pState)
// ..AA
try_definition context InstanceToken pos pState try_definition context InstanceToken pos pState
| ~(isGlobalContext context) | ~(isGlobalContext context)
= (False,abort "no def(2)",parseError "definition" No "instance declarations are only at the global level" pState) = (False,abort "no def(2)",parseError "definition" No "instance declarations are only at the global level" pState)
...@@ -1062,22 +1069,30 @@ wantInstanceDeclaration context pi_pos pState ...@@ -1062,22 +1069,30 @@ wantInstanceDeclaration context pi_pos pState
(pi_class, pState) = stringToIdent class_name IC_Class pState (pi_class, pState) = stringToIdent class_name IC_Class pState
((pi_types, pi_context), pState) = want_instance_type 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_name (IC_Instance pi_types) pState
// AA..
# (token, pState) = nextToken TypeContext pState
| token == GenericToken
# pState = wantEndOfDefinition "generic instance declaration" pState
= (PD_Instance {pi_class = pi_class, pi_ident = pi_ident, pi_types = pi_types, pi_context = pi_context,
pi_members = [], pi_specials = SP_None, pi_pos = pi_pos, pi_generate = True}, pState)
// ..AA
| isIclContext context | isIclContext context
# pState = want_begin_group pState # pState = tokenBack pState // AA
pState = want_begin_group pState
(pi_members, pState) = wantDefinitions context pState (pi_members, pState) = wantDefinitions context pState
pState = wantEndGroup "instance" pState pState = wantEndGroup "instance" pState
= (PD_Instance {pi_class = pi_class, pi_ident = pi_ident, pi_types = pi_types, pi_context = pi_context, = (PD_Instance {pi_class = pi_class, pi_ident = pi_ident, pi_types = pi_types, pi_context = pi_context,
pi_members = pi_members, pi_specials = SP_None, pi_pos = pi_pos }, pState) pi_members = pi_members, pi_specials = SP_None, pi_pos = pi_pos, pi_generate = False }, pState)
// otherwise // ~ (isIclContext context) // otherwise // ~ (isIclContext context)
# (token, pState) = nextToken TypeContext pState
| token == CommaToken | token == CommaToken
// AA: # (token, pState) = nextToken TypeContext pState
# (pi_types_and_contexts, pState) = want_instance_types pState # (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_name (IC_Instance type) \\ (type,context) <- pi_types_and_contexts] pState
= (PD_Instances = (PD_Instances
// [ { pi_class = pi_class, pi_ident = pi_ident, pi_types = type, pi_context = context // voor martin // [ { 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