Skip to content
GitLab
Commit cb25cd5b authored by clean's avatar clean
Browse files

optimizations and caching of dcl modules (without trans.icl)

parent e86f457f
Hide whitespace changes
Inline Side-by-side
frontend/StdCompare.icl
View file @ cb25cd5b
......@@ -117,6 +117,7 @@ where
= compare_indexes symb1 symb2
with
compare_indexes (SK_Function i1) (SK_Function i2) = i1 =< i2
compare_indexes (SK_LocalMacroFunction i1) (SK_LocalMacroFunction i2) = i1 =< i2
// compare_indexes (SK_ClassRecord i1) (SK_ClassRecord i2) = i1 =< i2
compare_indexes (SK_Constructor i1) (SK_Constructor i2) = i1 =< i2
// compare_indexes (SK_DeltaFunction i1) (SK_DeltaFunction i2) = i1 =< i2
......
frontend/analtypes.dcl
View file @ cb25cd5b
......@@ -2,7 +2,6 @@ definition module analtypes
import checksupport, typesupport
analTypeDefs :: !{#CommonDefs} !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
analTypeDefs :: !{#CommonDefs} !ModuleNumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
instance <<< TypeKind
frontend/analtypes.icl
View file @ cb25cd5b
......@@ -243,9 +243,11 @@ where
check_types_of_cons :: ![AType] !Bool !Index !Level ![TypeVar] !TypeAttribute ![AttrInequality] !Conditions !*TypeSymbols !*TypeInfo !*CheckState
-> *(![AType], ![[ATypeVar]], ![AttrInequality], !TypeProperties, !Conditions, !Int, !*TypeSymbols, !*TypeInfo, !*CheckState)
*/
new_local_kind_variables :: .[ATypeVar] *(*Heap TypeVarInfo,*Heap .KindInfo) -> (!Bool,!.Heap TypeVarInfo,!.Heap KindInfo);
new_local_kind_variables td_args (type_var_heap, as_kind_heap)
= foldSt new_kind td_args (True, type_var_heap, as_kind_heap)
where
new_kind :: ATypeVar *(.Bool,*Heap TypeVarInfo,*Heap .KindInfo) -> (!Bool,!.Heap TypeVarInfo,!.Heap KindInfo);
new_kind {atv_variable={tv_info_ptr},atv_attribute} (coercible, type_var_heap, kind_heap)
# (kind_info_ptr, kind_heap) = newPtr KI_Const kind_heap
= (coercible && is_not_a_variable atv_attribute, type_var_heap <:= (tv_info_ptr, TVI_TypeKind kind_info_ptr),
......@@ -293,6 +295,7 @@ emptyIdent name :== { id_name = name, id_info = nilPtr }
newKindVariables td_args (type_var_heap, as_kind_heap)
= mapSt new_kind td_args (type_var_heap, as_kind_heap)
where
new_kind :: ATypeVar *(*Heap TypeVarInfo,*Heap .KindInfo) -> (!.TypeKind,!(!.Heap TypeVarInfo,!.Heap KindInfo));
new_kind {atv_variable={tv_info_ptr}} (type_var_heap, kind_heap)
# (kind_info_ptr, kind_heap) = newPtr KI_Const kind_heap
= (KindVar kind_info_ptr, (type_var_heap <:= (tv_info_ptr, TVI_TypeKind kind_info_ptr), kind_heap <:= (kind_info_ptr, KI_Var kind_info_ptr)))
......@@ -451,13 +454,16 @@ where
is_a_top_var var_number []
= False
//import RWSDebug
analTypeDefs :: !{#CommonDefs} !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
analTypeDefs modules heaps error
analTypeDefs :: !{#CommonDefs} !ModuleNumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
analTypeDefs modules used_module_numbers heaps error
// #! modules = modules ---> "analTypeDefs"
# sizes = [ size mod.com_type_defs - size mod.com_class_defs \\ mod <-: modules ]
// # sizes = [ size mod.com_type_defs - size mod.com_class_defs \\ mod <-: modules ]
// # used_module_numbers = used_module_numbers <<- used_module_numbers
# sizes = [ if (in_module_number_set module_n used_module_numbers) (size mod.com_type_defs - size mod.com_class_defs) 0 \\ mod <-: modules & module_n<-[0..]]
check_marks = { createArray nr_of_types AS_NotChecked \\ nr_of_types <- sizes }
check_marks = { createArray nr_of_types AS_NotChecked \\ nr_of_types <- sizes }
type_def_infos = { createArray nr_of_types EmptyTypeDefInfo \\ nr_of_types <- sizes }
as = { as_check_marks = check_marks, as_kind_heap = newHeap, as_heaps = heaps, as_td_infos = type_def_infos,
......@@ -472,7 +478,6 @@ where
anal_type_defs _ _ [] as
= as
anal_type_def modules mod_index type_index as=:{as_check_marks}
| as_check_marks.[mod_index].[type_index] == AS_NotChecked
# (_, (_, as)) = analTypeDef modules mod_index type_index as
......
frontend/analunitypes.dcl
View file @ cb25cd5b
......@@ -11,4 +11,3 @@ signClassification :: !Index !Index ![SignClassification] !{# CommonDefs } !*T
propClassification :: !Index !Index ![PropClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos
-> (!PropClassification, !*TypeVarHeap, !*TypeDefInfos)
frontend/analunitypes.icl
View file @ cb25cd5b
......@@ -60,7 +60,7 @@ removeTopClasses _ _
, scs_rec_appls :: ![RecTypeApplication (Sign, [SignClassification])]
}
determineSignClassOfTypeDef :: !Int !Int ![ATypeVar] !TypeDefInfo ![SignClassification] {# CommonDefs} !*TypeVarHeap !*TypeDefInfos
determineSignClassOfTypeDef :: !Int !Int ![ATypeVar] !TypeDefInfo ![SignClassification] !{# CommonDefs} !*TypeVarHeap !*TypeDefInfos
-> (!SignClassification, !*TypeVarHeap,!*TypeDefInfos)
determineSignClassOfTypeDef type_index module_index td_args {tdi_classification,tdi_cons_vars,tdi_group_vars,tdi_group,tdi_group_nr}
hio_signs ci type_var_heap td_infos
......@@ -309,8 +309,7 @@ propClassification type_index module_index hio_props defs type_var_heap td_infos
(td_info, td_infos) = td_infos![module_index].[type_index]
= determinePropClassOfTypeDef type_index module_index td_args td_info hio_props defs type_var_heap td_infos
determinePropClassOfTypeDef :: !Int !Int ![ATypeVar] !TypeDefInfo ![PropClassification] {# CommonDefs} !*TypeVarHeap !*TypeDefInfos
determinePropClassOfTypeDef :: !Int !Int ![ATypeVar] !TypeDefInfo ![PropClassification] !{# CommonDefs} !*TypeVarHeap !*TypeDefInfos
-> (!PropClassification,!*TypeVarHeap, !*TypeDefInfos)
determinePropClassOfTypeDef type_index module_index td_args {tdi_classification, tdi_kinds, tdi_group, tdi_group_vars, tdi_cons_vars, tdi_group_nr}
hio_props ci type_var_heap td_infos
......
frontend/check.dcl
View file @ cb25cd5b
......@@ -4,8 +4,8 @@ import syntax, transform, checksupport, typesupport, predef
cPredefinedModuleIndex :== 1
checkModule :: !ScannedModule !IndexRange ![FunDef] !ScannedModule !ScannedModule ![ScannedModule] !*PredefinedSymbols !*SymbolTable !*File
-> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File)
checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !{#FunDef} !*PredefinedSymbols !*SymbolTable !*File !*Heaps
-> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !.{#FunDef},!Int, !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File)
retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Index)
......
frontend/check.icl
View file @ cb25cd5b
......@@ -2,7 +2,7 @@ implementation module check
import StdEnv
import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef, RWSDebug
import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef //, RWSDebug
import explicitimports, comparedefimp
cPredefinedModuleIndex :== 1
......@@ -248,7 +248,7 @@ where
# class_def = dcl_mod.dcl_common.com_class_defs.[ste_index]
= (ste_index, dcl_index, class_def, class_defs, modules)
get_class_def _ mod_index class_defs modules
= (NotFound, cIclModIndex, abort "no class definition", class_defs, modules)
= (NotFound, -1/*cIclModIndex*/, abort "no class definition", class_defs, modules)
checkInstances :: !Index !*CommonDefs !u:{# DclModule} !*VarHeap !*TypeHeaps !*CheckState
-> (![(Index,SymbolType)], !*CommonDefs, !u:{# DclModule}, !*VarHeap , !*TypeHeaps, !*CheckState)
......@@ -567,14 +567,15 @@ where
No
-> (No, selector_defs, type_defs, modules, { cs & cs_error = checkError "" " could not determine the type of this record" cs.cs_error })
check_and_rearrange_fields :: Int Int {#FieldSymbol} ![Bind ParsedExpr (Ident,[Global .Int])] *ErrorAdmin -> ([Bind ParsedExpr .(Global FieldSymbol)],!.ErrorAdmin);
check_and_rearrange_fields mod_index field_index fields field_ass cs_error
| field_index < size fields
# (field_expr, field_ass) = look_up_field mod_index fields.[field_index] field_ass
(field_exprs, cs_error) = check_and_rearrange_fields mod_index (inc field_index) fields field_ass cs_error
= ([field_expr : field_exprs], cs_error)
| isEmpty field_ass
= ([], cs_error)
= ([], foldSt field_error field_ass cs_error)
| isEmpty field_ass
= ([], cs_error)
= ([], foldSt field_error field_ass cs_error)
where
look_up_field mod_index field []
......@@ -620,11 +621,9 @@ where
// , ei_fun_kind :: !FunKind
}
cIsInExpressionList :== True
cIsNotInExpressionList :== False
:: UnfoldMacroState =
{ ums_var_heap :: !.VarHeap
, ums_modules :: !.{# DclModule}
......@@ -701,12 +700,12 @@ checkPatternConstructor :: !Index !Bool !SymbolTableEntry !Ident !(Optional (Bin
-> (!AuxiliaryPattern, !*PatternState, !*ExpressionInfo, !*CheckState);
checkPatternConstructor _ _ {ste_kind = STE_Empty} ident _ ps e_info cs=:{cs_error}
= (AP_Empty ident, ps, e_info, { cs & cs_error = checkError ident " not defined" cs_error })
checkPatternConstructor mod_index is_expr_list {ste_kind = STE_FunctionOrMacro _,ste_index} ident opt_var ps=:{ps_fun_defs} e_info cs=:{cs_error}
checkPatternConstructor mod_index is_expr_list {ste_kind = STE_FunctionOrMacro _,ste_index} ident opt_var ps=:{ps_fun_defs} e_info cs=:{cs_error,cs_x}
# ({fun_symb,fun_arity,fun_kind,fun_priority},ps_fun_defs) = ps_fun_defs![ste_index]
ps = { ps & ps_fun_defs = ps_fun_defs }
| fun_kind == FK_Macro
| is_expr_list
# macro_symbol = { glob_object = MakeDefinedSymbol fun_symb ste_index fun_arity, glob_module = cIclModIndex }
# macro_symbol = { glob_object = MakeDefinedSymbol fun_symb ste_index fun_arity, glob_module = cs_x.x_main_dcl_module_n }
= (AP_Constant APK_Macro macro_symbol fun_priority, ps, e_info, cs)
| fun_arity == 0
# (pattern, ps, ef_modules, ef_cons_defs, cs_error)
......@@ -896,9 +895,9 @@ checkPattern (PE_List [exp1, exp2 : exps]) opt_var p_input accus ps e_info cs
= (opt_var, error)
*/
checkPattern (PE_DynamicPattern pattern type) opt_var p_input accus ps e_info cs
checkPattern (PE_DynamicPattern pattern type) opt_var p_input accus ps e_info cs=:{cs_x}
# (dyn_pat, accus, ps, e_info, cs) = checkPattern pattern No p_input accus ps e_info cs
= (AP_Dynamic dyn_pat type opt_var, accus, ps, e_info, { cs & cs_needed_modules = cs.cs_needed_modules bitor cNeedStdDynamics })
= (AP_Dynamic dyn_pat type opt_var, accus, ps, e_info, { cs & cs_x.x_needed_modules = cs_x.x_needed_modules bitor cNeedStdDynamics })
checkPattern (PE_Basic basic_value) opt_var p_input accus ps e_info cs
= (AP_Basic basic_value opt_var, accus, ps, e_info, cs)
......@@ -1072,13 +1071,13 @@ where
check_id_expression :: !SymbolTableEntry !Bool ![FreeVar] !Ident !ExpressionInput !*ExpressionState !u:ExpressionInfo !*CheckState
-> (!Expression, ![FreeVar], !*ExpressionState, !u:ExpressionInfo, !*CheckState)
check_id_expression {ste_kind = STE_Empty} is_expr_list free_vars id e_input e_state e_info cs=:{cs_error,cs_predef_symbols}
check_id_expression {ste_kind = STE_Empty} is_expr_list free_vars id e_input e_state e_info cs=:{cs_error,cs_predef_symbols,cs_x}
# ({pds_ident=from_ident}) = cs_predef_symbols.[PD_From]
({pds_ident=from_then_ident}) = cs_predef_symbols.[PD_FromThen]
({pds_ident=from_to_ident}) = cs_predef_symbols.[PD_FromTo]
({pds_ident=from_then_to_ident}) = cs_predef_symbols.[PD_FromThenTo]
| id==from_ident || id==from_then_ident || id==from_to_ident || id==from_then_to_ident
= (EE, free_vars, e_state, e_info, { cs & cs_needed_modules = cs.cs_needed_modules bitor cNeedStdEnum})
= (EE, free_vars, e_state, e_info, { cs & cs_x.x_needed_modules = cs_x.x_needed_modules bitor cNeedStdEnum})
// instead of giving an error message remember that StdEnum should have been imported.
// Error will be given in function check_needed_modules_are_imported
# ({pds_ident=createArray_ident}) = cs_predef_symbols.[PD__CreateArrayFun]
......@@ -1086,7 +1085,7 @@ where
({pds_ident=update_ident}) = cs_predef_symbols.[PD_ArrayUpdateFun]
({pds_ident=usize_ident}) = cs_predef_symbols.[PD_UnqArraySizeFun]
| id==createArray_ident || id==uselect_ident || id==update_ident || id==usize_ident
= (EE, free_vars, e_state, e_info, { cs & cs_needed_modules = cs.cs_needed_modules bitor cNeedStdArray})
= (EE, free_vars, e_state, e_info, { cs & cs_x.x_needed_modules = cs_x.x_needed_modules bitor cNeedStdArray})
// instead of giving an error message remember that StdArray should have been be imported.
// Error will be given in function check_needed_modules_are_imported
= (EE, free_vars, e_state, e_info, { cs & cs_error = checkError id "undefined" cs_error })
......@@ -1109,16 +1108,20 @@ where
determine_info_of_symbol :: !SymbolTableEntry !SymbolPtr !ExpressionInput !*ExpressionState !u:ExpressionInfo !*CheckState
-> (!SymbKind, !Int, !Priority, !Bool, !*ExpressionState, !u:ExpressionInfo,!*CheckState)
determine_info_of_symbol entry=:{ste_kind=STE_FunctionOrMacro calls,ste_index,ste_def_level} symb_info
e_input=:{ei_fun_index, ei_mod_index} e_state=:{es_fun_defs,es_calls} e_info cs=:{cs_symbol_table}
e_input=:{ei_fun_index, ei_mod_index} e_state=:{es_fun_defs,es_calls} e_info=:{ef_is_macro_fun} cs=:{cs_symbol_table,cs_x}
# ({fun_symb,fun_arity,fun_kind,fun_priority}, es_fun_defs) = es_fun_defs![ste_index]
# index = { glob_object = ste_index, glob_module = cIclModIndex }
# index = { glob_object = ste_index, glob_module = cs_x.x_main_dcl_module_n }
| is_called_before ei_fun_index calls
| fun_kind == FK_Macro
= (SK_Macro index, fun_arity, fun_priority, cIsAFunction, { e_state & es_fun_defs = es_fun_defs }, e_info, cs)
= (SK_Function index, fun_arity, fun_priority, cIsAFunction, { e_state & es_fun_defs = es_fun_defs }, e_info, cs)
// = (SK_Function index, fun_arity, fun_priority, cIsAFunction, { e_state & es_fun_defs = es_fun_defs }, e_info, cs)
# symbol_kind = if ef_is_macro_fun (SK_LocalMacroFunction ste_index) (SK_Function index)
= (symbol_kind, fun_arity, fun_priority, cIsAFunction, { e_state & es_fun_defs = es_fun_defs }, e_info, cs)
# cs = { cs & cs_symbol_table = cs_symbol_table <:= (symb_info, { entry & ste_kind = STE_FunctionOrMacro [ ei_fun_index : calls ]})}
e_state = { e_state & es_fun_defs = es_fun_defs, es_calls = [{ fc_index = ste_index, fc_level = ste_def_level} : es_calls ]}
= (if (fun_kind == FK_Macro) (SK_Macro index) (SK_Function index), fun_arity, fun_priority, cIsAFunction, e_state, e_info, cs)
// = (if (fun_kind == FK_Macro) (SK_Macro index) (SK_Function index), fun_arity, fun_priority, cIsAFunction, e_state, e_info, cs)
# symbol_kind = if (fun_kind == FK_Macro) (SK_Macro index) (if ef_is_macro_fun (SK_LocalMacroFunction ste_index) (SK_Function index))
= (symbol_kind, fun_arity, fun_priority, cIsAFunction, e_state, e_info, cs)
where
is_called_before caller_index []
= False
......@@ -1545,6 +1548,7 @@ checkExpression free_vars rec=:(PE_Record record opt_type fields) e_input=:{ei_e
where
remove_fields binds = [ bind_src \\ {bind_src} <- binds ]
check_field_exprs :: [FreeVar] [Bind ParsedExpr (Global FieldSymbol)] Int RecordKind ExpressionInput !*ExpressionState !*ExpressionInfo !*CheckState -> *(![.Bind Expression (Global FieldSymbol)],![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState);
check_field_exprs free_vars [] field_nr record_kind e_input e_state e_info cs
= ([], free_vars, e_state, e_info, cs)
check_field_exprs free_vars [field_expr : field_exprs] field_nr record_kind e_input e_state e_info cs
......@@ -1553,6 +1557,7 @@ where
(exprs, free_vars, e_state, e_info, cs) = check_field_exprs free_vars field_exprs (inc field_nr) record_kind e_input e_state e_info cs
= ([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
# (expr, free_vars, e_state, e_info, cs)
= checkIdentExpression cIsNotInExpressionList free_vars fs_var e_input e_state e_info cs
......@@ -1585,12 +1590,12 @@ where
get_field_var _
= ({ id_name = "** ERRONEOUS **", id_info = nilPtr }, nilPtr)
checkExpression free_vars (PE_Dynamic expr opt_type) e_input e_state=:{es_expr_heap,es_dynamics} e_info cs
checkExpression free_vars (PE_Dynamic expr opt_type) e_input e_state=:{es_expr_heap,es_dynamics} e_info cs=:{cs_x}
# (dyn_info_ptr, es_expr_heap) = newPtr (EI_Dynamic opt_type) es_expr_heap
(dyn_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars expr e_input
{e_state & es_dynamics = [dyn_info_ptr : es_dynamics], es_expr_heap = es_expr_heap } e_info cs
= (DynamicExpr { dyn_expr = dyn_expr, dyn_opt_type = opt_type, dyn_info_ptr = dyn_info_ptr, dyn_type_code = TCE_Empty, dyn_uni_vars = [] },
free_vars, e_state, e_info, { cs & cs_needed_modules = cs.cs_needed_modules bitor cNeedStdDynamics })
free_vars, e_state, e_info, { cs & cs_x.x_needed_modules = cs_x.x_needed_modules bitor cNeedStdDynamics })
checkExpression free_vars (PE_Basic basic_value) e_input e_state e_info cs
# (basic_type, cs) = typeOfBasicValue basic_value cs
......@@ -1717,6 +1722,7 @@ buildLetExpression let_strict_binds let_lazy_binds expr expr_heap
# (let_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
= (Let {let_strict_binds = let_strict_binds, let_lazy_binds = let_lazy_binds, let_expr = expr, let_info_ptr = let_expr_ptr }, expr_heap)
checkLhssOfLocalDefs :: .Int .Int LocalDefs *ExpressionState *ExpressionInfo *CheckState -> (!.[NodeDef AuxiliaryPattern],!(![Ident],![ArrayPattern]),!.ExpressionState,!.ExpressionInfo,!.CheckState);
checkLhssOfLocalDefs def_level mod_index (CollectedLocalDefs {loc_functions={ir_from,ir_to},loc_nodes}) e_state=:{es_var_heap,es_fun_defs} e_info cs
# (loc_defs, accus, {ps_fun_defs,ps_var_heap}, e_info, cs)
= check_patterns loc_nodes {pi_def_level = def_level, pi_mod_index = mod_index, pi_is_node_pattern = True } ([], [])
......@@ -1919,7 +1925,6 @@ where
(expr, free_vars, e_state, e_info, cs) = check_opt_guarded_alts free_vars alt_expr e_input e_state e_info cs
= (let_vars_list, [(let_binds, guard, expr, alt_ident) : rev_guarded_exprs], ei_expr_level, free_vars, e_state, e_info, cs )
// JVG: added type
check_unguarded_expression :: [FreeVar] ExprWithLocalDefs ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!Expression,![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState);
check_unguarded_expression free_vars {ewl_nodes,ewl_expr,ewl_locals,ewl_position} e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
# this_expr_level = inc ei_expr_level
......@@ -1946,7 +1951,8 @@ where
= symbol_table
remove_seq_let_vars level [let_vars : let_vars_list] symbol_table
= remove_seq_let_vars (dec level) let_vars_list (removeLocalIdentsFromSymbolTable level let_vars symbol_table)
check_sequential_lets :: [FreeVar] [NodeDefWithLocals] u:[[Ident]] !ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(![.([Bind Expression FreeVar],![Bind Expression FreeVar])],!u:[[Ident]],!Int,![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState);
check_sequential_lets free_vars [seq_let:seq_lets] let_vars_list e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
# ei_expr_level
= inc ei_expr_level
......@@ -1969,7 +1975,6 @@ where
check_sequential_lets free_vars [] let_vars_list e_input=:{ei_expr_level} e_state e_info cs
= ([], let_vars_list, ei_expr_level, free_vars, e_state, e_info, cs)
// JVG: added type
check_sequential_let :: [FreeVar] NodeDefWithLocals ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!Expression,!AuxiliaryPattern,!(![Ident],![ArrayPattern]),![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState);
check_sequential_let free_vars {ndwl_def={bind_src,bind_dst},ndwl_locals, ndwl_position} e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
# cs = pushErrorAdmin (newPosition {id_name="node definition", id_info=nilPtr} ndwl_position) cs
......@@ -2004,6 +2009,7 @@ determinePatternVariable No var_heap
# (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
= ({ bind_src = newVarId "_x", bind_dst = new_info_ptr }, var_heap)
convertSubPatterns :: [AuxiliaryPattern] Expression Position *(Heap VarInfo) *(Heap ExprInfo) u:[Ptr ExprInfo] *CheckState -> *(!.[FreeVar],!Expression,!Position,!*Heap VarInfo,!*Heap ExprInfo,!u:[Ptr ExprInfo],!*CheckState);
convertSubPatterns [] result_expr pattern_position var_store expr_heap opt_dynamics cs
= ([], result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
convertSubPatterns [pattern : patterns] result_expr pattern_position var_store expr_heap opt_dynamics cs
......@@ -2013,6 +2019,7 @@ convertSubPatterns [pattern : patterns] result_expr pattern_position var_store e
= convertSubPattern pattern result_expr pattern_position var_store expr_heap opt_dynamics cs
= ([var_arg : var_args], result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
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 }
......@@ -2243,7 +2250,7 @@ where
transform_patterns_into_cases [] _ result_expr pattern_position var_store expr_heap opt_dynamics cs
= (result_expr, pattern_position, var_store, expr_heap, opt_dynamics, cs)
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
......@@ -2417,14 +2424,13 @@ checkMacros mod_index range fun_defs e_info=:{ef_is_macro_fun=ef_is_macro_fun_ol
{ cs & cs_symbol_table = cs_symbol_table, cs_predef_symbols = cs_predef_symbols, cs_error = cs_error })
checkInstanceBodies :: !IndexRange !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef},!*ExpressionInfo,!*Heaps, !*CheckState);
checkInstanceBodies {ir_from, ir_to} fun_defs e_info heaps cs
= checkFunctions cIclModIndex cGlobalScope ir_from ir_to fun_defs e_info heaps cs
checkInstanceBodies {ir_from, ir_to} fun_defs e_info heaps cs=:{cs_x}
= checkFunctions cs_x.x_main_dcl_module_n cGlobalScope ir_from ir_to fun_defs e_info heaps cs
instance < FunDef
where
(<) fd1 fd2 = fd1.fun_symb.id_name < fd2.fun_symb.id_name
createCommonDefinitions {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances}
= { com_type_defs = { type \\ type <- def_types }
, com_cons_defs = { cons \\ cons <- def_constructors }
......@@ -2433,16 +2439,18 @@ createCommonDefinitions {def_types,def_constructors,def_selectors,def_macros,def
, com_member_defs = { member \\ member <- def_members }
, com_instance_defs = { next_instance \\ next_instance <- def_instances }
}
IsMainDclMod is_dcl module_index :== is_dcl && module_index == cIclModIndex
//IsMainDclMod is_dcl module_index :== is_dcl && module_index == cIclModIndex
array_plus_list a [] = a
array_plus_list a l = arrayPlusList a l
checkCommonDefinitions :: !Bool !Index !*CommonDefs !*{# DclModule} !*TypeHeaps !*VarHeap !*CheckState
-> (!*CommonDefs, !*{# DclModule}, !*TypeHeaps, !*VarHeap, !*CheckState)
checkCommonDefinitions is_dcl module_index common modules type_heaps var_heap cs
#! is_main_dcl_mod = is_dcl && module_index == cs.cs_x.x_main_dcl_module_n
# (com_type_defs, com_cons_defs, com_selector_defs, modules, var_heap, type_heaps, cs)
= checkTypeDefs (IsMainDclMod is_dcl module_index) common.com_type_defs module_index
= checkTypeDefs is_main_dcl_mod common.com_type_defs module_index
common.com_cons_defs common.com_selector_defs modules var_heap type_heaps cs
(com_class_defs, com_member_defs, com_type_defs, modules, type_heaps, cs)
= checkTypeClasses 0 module_index common.com_class_defs common.com_member_defs com_type_defs modules type_heaps cs
......@@ -2450,12 +2458,19 @@ checkCommonDefinitions is_dcl module_index common modules type_heaps var_heap cs
= checkMemberTypes module_index com_member_defs com_type_defs com_class_defs modules type_heaps var_heap cs
(com_instance_defs, com_type_defs, com_class_defs, com_member_defs, modules, type_heaps, cs)
= checkInstanceDefs module_index common.com_instance_defs com_type_defs com_class_defs com_member_defs modules type_heaps cs
(size_com_type_defs,com_type_defs) = usize com_type_defs
(size_com_selector_defs,com_selector_defs) = usize com_selector_defs
(size_com_cons_defs,com_cons_defs) = usize com_cons_defs
(com_class_defs, modules, new_type_defs, new_selector_defs, new_cons_defs, th_vars, var_heap, cs)
= createClassDictionaries module_index com_class_defs modules (size com_type_defs) (size com_selector_defs)
(size com_cons_defs) type_heaps.th_vars var_heap cs
com_type_defs = { type_def \\ type_def <- [ type_def \\ type_def <-: com_type_defs ] ++ new_type_defs }
com_selector_defs = { sel_def \\ sel_def <- [ sel_def \\ sel_def <-: com_selector_defs ] ++ new_selector_defs }
com_cons_defs = { cons_def \\ cons_def <- [ cons_def \\ cons_def <-: com_cons_defs ] ++ new_cons_defs }
= createClassDictionaries module_index com_class_defs modules size_com_type_defs size_com_selector_defs size_com_cons_defs
type_heaps.th_vars var_heap cs
com_type_defs = array_plus_list com_type_defs new_type_defs
com_selector_defs = array_plus_list com_selector_defs new_selector_defs
com_cons_defs = array_plus_list com_cons_defs new_cons_defs
= ({common & com_type_defs = com_type_defs, com_cons_defs = com_cons_defs, com_selector_defs = com_selector_defs, com_class_defs = com_class_defs,
com_member_defs = com_member_defs, com_instance_defs = com_instance_defs }, modules, { type_heaps & th_vars = th_vars }, var_heap, cs)
......@@ -2477,17 +2492,17 @@ collectCommonfinitions {def_types,def_constructors,def_selectors,def_macros,def_
sizes = { sizes & [cMemberDefs] = size }
= (sizes, defs)
where
type_def_to_dcl {td_name, td_pos} (dcl_index, decls)
type_def_to_dcl {td_name, td_pos} (dcl_index, decls)
= (inc dcl_index, [{ dcl_ident = td_name, dcl_pos = td_pos, dcl_kind = STE_Type, dcl_index = dcl_index } : decls])
cons_def_to_dcl {cons_symb, cons_pos} (dcl_index, decls)
cons_def_to_dcl {cons_symb, cons_pos} (dcl_index, decls)
= (inc dcl_index, [{ dcl_ident = cons_symb, dcl_pos = cons_pos, dcl_kind = STE_Constructor, dcl_index = dcl_index } : decls])
selector_def_to_dcl {sd_symb, sd_field, sd_pos} (dcl_index, decls)
selector_def_to_dcl {sd_symb, sd_field, sd_pos} (dcl_index, decls)
= (inc dcl_index, [{ dcl_ident = sd_field, dcl_pos = sd_pos, dcl_kind = STE_Field sd_symb, dcl_index = dcl_index } : decls])
class_def_to_dcl {class_name, class_pos} (dcl_index, decls)
class_def_to_dcl {class_name, class_pos} (dcl_index, decls)
= (inc dcl_index, [{ dcl_ident = class_name, dcl_pos = class_pos, dcl_kind = STE_Class, dcl_index = dcl_index } : decls])
member_def_to_dcl {me_symb, me_pos} (dcl_index, decls)
member_def_to_dcl {me_symb, me_pos} (dcl_index, decls)
= (inc dcl_index, [{ dcl_ident = me_symb, dcl_pos = me_pos, dcl_kind = STE_Member, dcl_index = dcl_index } : decls])
instance_def_to_dcl {ins_ident, ins_pos} (dcl_index, decls)
instance_def_to_dcl {ins_ident, ins_pos} (dcl_index, decls)
= (inc dcl_index, [{ dcl_ident = ins_ident, dcl_pos = ins_pos, dcl_kind = STE_Instance, dcl_index = dcl_index } : decls])
collectMacros {ir_from,ir_to} macro_defs sizes_defs
......@@ -2508,11 +2523,89 @@ where
# ({fun_symb, fun_pos}, fun_defs) = fun_defs![dcl_index]
= ([{ dcl_ident = fun_symb, dcl_pos = fun_pos, dcl_kind = STE_FunctionOrMacro [], dcl_index = dcl_index } : defs], fun_defs)
combineDclAndIclModule :: !ModuleKind !*{#DclModule} ![Declaration] !(CollectedDefinitions b c) !*{#Int} !*CheckState -> (!*{#DclModule},![Declaration],!CollectedDefinitions b c,!*{#Int},!*CheckState);
renumber_icl_definitions_as_dcl_definitions MK_Main icl_decl_symbols modules cdefs icl_sizes cs
= (icl_decl_symbols,modules,cdefs,cs)
renumber_icl_definitions_as_dcl_definitions _ icl_decl_symbols modules cdefs icl_sizes cs
#! main_dcl_module_n=cs.cs_x.x_main_dcl_module_n
# (dcl_mod,modules) = modules![main_dcl_module_n]
# (Yes conversion_table) = dcl_mod.dcl_conversions
# icl_to_dcl_index_table = {create_icl_to_dcl_index_table_for_kind table_size dcl_to_icl_table \\ table_size <-: icl_sizes & dcl_to_icl_table <-: conversion_table }
with
create_icl_to_dcl_index_table_for_kind table_size dcl_to_icl_table
# icl_to_dcl_index_table_for_kind = {createArray table_size NoIndex & [dcl_to_icl_table.[dcl_index]]=dcl_index \\ dcl_index<- [0..size dcl_to_icl_table-1]}
#! max_index=size icl_to_dcl_index_table_for_kind-1
# icl_to_dcl_index_table_for_kind = number_NoIndex_elements max_index max_index icl_to_dcl_index_table_for_kind
with
number_NoIndex_elements :: Int Int *{#Int} -> .{#Int};
number_NoIndex_elements index free_position_index icl_to_dcl_index_table_for_kind
| index>=0
| icl_to_dcl_index_table_for_kind.[index]==NoIndex
= number_NoIndex_elements (index-1) (free_position_index-1) {icl_to_dcl_index_table_for_kind & [index]=free_position_index}
= number_NoIndex_elements (index-1) free_position_index icl_to_dcl_index_table_for_kind
= icl_to_dcl_index_table_for_kind
= icl_to_dcl_index_table_for_kind
# modules = {modules & [main_dcl_module_n] = { dcl_mod & dcl_conversions = Yes conversion_table}}
# (icl_decl_symbols,cdefs) = renumber_icl_decl_symbols icl_decl_symbols cdefs
with
renumber_icl_decl_symbols [] cdefs
= ([],cdefs)
renumber_icl_decl_symbols [icl_decl_symbol : icl_decl_symbols] cdefs
# (icl_decl_symbol,cdefs) = renumber_icl_decl_symbol icl_decl_symbol cdefs
# (icl_decl_symbols,cdefs) = renumber_icl_decl_symbols icl_decl_symbols cdefs
= ([icl_decl_symbol : icl_decl_symbols],cdefs)
where
renumber_icl_decl_symbol icl_decl_symbol=:{dcl_kind = STE_Type, dcl_index} cdefs
# (type_def,cdefs) = cdefs!com_type_defs.[dcl_index]
# type_def = renumber_type_def type_def
# cdefs={cdefs & com_type_defs.[dcl_index]=type_def}
= ({icl_decl_symbol & dcl_index=icl_to_dcl_index_table.[cTypeDefs,dcl_index]},cdefs)
where
renumber_type_def td=:{td_rhs = AlgType conses}
# conses = [{cons & ds_index=icl_to_dcl_index_table.[cConstructorDefs,cons.ds_index]} \\ cons <- conses]
= { td & td_rhs = AlgType conses}
renumber_type_def td=:{td_rhs = RecordType rt=:{rt_constructor,rt_fields}}
# rt_constructor = {rt_constructor & ds_index=icl_to_dcl_index_table.[cConstructorDefs,rt_constructor.ds_index]}
# rt_fields = {{field & fs_index=icl_to_dcl_index_table.[cSelectorDefs,field.fs_index]} \\ field <-: rt_fields}
= {td & td_rhs=RecordType {rt_constructor=rt_constructor,rt_fields=rt_fields}}
renumber_type_def td
= td
renumber_icl_decl_symbol icl_decl_symbol=:{dcl_kind = STE_Constructor, dcl_index} cdefs
= ({icl_decl_symbol & dcl_index=icl_to_dcl_index_table.[cConstructorDefs,dcl_index]},cdefs)
renumber_icl_decl_symbol icl_decl_symbol=:{dcl_kind = STE_Field _, dcl_index} cdefs
= ({icl_decl_symbol & dcl_index=icl_to_dcl_index_table.[cSelectorDefs,dcl_index]},cdefs)
renumber_icl_decl_symbol icl_decl_symbol=:{dcl_kind = STE_Member, dcl_index} cdefs
= ({icl_decl_symbol & dcl_index=icl_to_dcl_index_table.[cMemberDefs,dcl_index]},cdefs)
renumber_icl_decl_symbol icl_decl_symbol=:{dcl_kind = STE_Class, dcl_index} cdefs
# (class_def,cdefs) = cdefs!com_class_defs.[dcl_index]
# class_members = {{class_member & ds_index=icl_to_dcl_index_table.[cMemberDefs,class_member.ds_index]} \\ class_member <-: class_def.class_members}
# class_def = {class_def & class_members=class_members}
# cdefs = {cdefs & com_class_defs.[dcl_index] =class_def}
= ({icl_decl_symbol & dcl_index=icl_to_dcl_index_table.[cClassDefs,dcl_index]},cdefs)
renumber_icl_decl_symbol icl_decl_symbol cdefs
= (icl_decl_symbol,cdefs)
# cdefs=reorder_common_definitions cdefs
with
reorder_common_definitions {com_type_defs,com_cons_defs,com_selector_defs,com_class_defs,com_member_defs,com_instance_defs}
# com_type_defs=reorder_array com_type_defs icl_to_dcl_index_table.[cTypeDefs]
# com_cons_defs=reorder_array com_cons_defs icl_to_dcl_index_table.[cConstructorDefs]
# com_selector_defs=reorder_array com_selector_defs icl_to_dcl_index_table.[cSelectorDefs]
# 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_type_defs=com_type_defs,com_cons_defs=com_cons_defs,com_selector_defs=com_selector_defs,com_class_defs=com_class_defs,com_member_defs=com_member_defs,com_instance_defs=com_instance_defs}
where
reorder_array array index_array
# new_array={e\\e<-:array}
= {new_array & [index_array.[i]]=e \\ e<-:array & i<-[0..]}
# conversion_table = {if (kind_index<=cMemberDefs) {i\\i<-[0..size table-1]} table \\ table<-:conversion_table & kind_index<-[0..]}
# modules = {modules & [main_dcl_module_n].dcl_conversions=Yes conversion_table}
= (icl_decl_symbols,modules,cdefs,cs)
combineDclAndIclModule :: ModuleKind *{#.DclModule} [.Declaration] (CollectedDefinitions a b) *{#.Int} *CheckState -> (!*{#DclModule},![Declaration],!CollectedDefinitions a b,!*{#Int},!.CheckState);
combineDclAndIclModule MK_Main modules icl_decl_symbols icl_definitions icl_sizes cs
= (modules, icl_decl_symbols, icl_definitions, icl_sizes, cs)
combineDclAndIclModule _ modules icl_decl_symbols icl_definitions icl_sizes cs
# (dcl_mod=:{dcl_declared={dcls_local},dcl_macros, dcl_sizes, dcl_common}, modules) = modules![cIclModIndex]
#! main_dcl_module_n=cs.cs_x.x_main_dcl_module_n
# (dcl_mod=:{dcl_declared={dcls_local},dcl_macros, dcl_sizes, dcl_common}, modules) = modules![main_dcl_module_n]
cs = addGlobalDefinitionsToSymbolTable icl_decl_symbols cs
......@@ -2523,7 +2616,7 @@ combineDclAndIclModule _ modules icl_decl_symbols icl_definitions icl_sizes cs
= foldSt (add_dcl_definition dcl_common) moved_dcl_defs ([], [], [], [], [], cs)
cs_symbol_table = removeDeclarationsFromSymbolTable icl_decl_symbols cGlobalScope cs.cs_symbol_table
= ( { modules & [cIclModIndex] = { dcl_mod & dcl_conversions = Yes conversion_table }}
= ( { modules & [main_dcl_module_n] = { dcl_mod & dcl_conversions = Yes conversion_table }}
, icl_decl_symbols
, { icl_definitions
& def_types = my_append icl_definitions.def_types new_type_defs
......@@ -2532,7 +2625,7 @@ combineDclAndIclModule _ modules icl_decl_symbols icl_definitions icl_sizes cs
, def_classes = my_append icl_definitions.def_classes new_class_defs
, def_members = my_append icl_definitions.def_members new_member_defs
}
, icl_sizes
, icl_sizes
, { cs & cs_symbol_table = cs_symbol_table }
)
where
......@@ -2655,16 +2748,31 @@ where
(<=<) infixl
(<=<) state fun :== fun state
checkModule :: !ScannedModule !IndexRange ![FunDef] !ScannedModule !ScannedModule ![ScannedModule] !*PredefinedSymbols !*SymbolTable !*File
-> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File)
checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs} icl_global_function_range fun_defs dcl_mod pre_def_mod scanned_modules predef_symbols symbol_table err_file
checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !{#FunDef} !*PredefinedSymbols !*SymbolTable !*File !*Heaps
-> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !.{#FunDef}, !Int,!*Heaps, !*PredefinedSymbols, !*SymbolTable, *File)
checkModule m icl_global_function_range fun_defs n_functions_and_macros_in_dcl_modules dcl_module_n_in_cache optional_dcl_mod scanned_modules dcl_modules functions_and_macros predef_symbols symbol_table err_file heaps
# (optional_pre_def_mod,predef_symbols)
= case size dcl_modules of
0 # (predef_mod,predef_symbols) = buildPredefinedModule predef_symbols
-> (Yes predef_mod,predef_symbols)
_ -> (No,predef_symbols)