Commit 5861a242 authored by Martin Wierich's avatar Martin Wierich
Browse files

bugfixes

parent 5f5c1fac
......@@ -2611,7 +2611,7 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
(icl_functions, e_info, heaps, cs) = checkMacros cIclModIndex cdefs.def_macros icl_functions e_info heaps cs
(icl_functions, e_info, heaps, cs) = checkFunctions cIclModIndex cGlobalScope 0 nr_of_global_funs icl_functions e_info heaps cs
(e_info, cs) = check_needed_modules_are_imported mod_name ".icl" e_info cs
cs = check_needed_modules_are_imported mod_name ".icl" cs
(icl_functions, e_info, heaps, {cs_symbol_table, cs_predef_symbols, cs_error})
= checkInstanceBodies {ir_from = first_inst_index, ir_to = nr_of_functions} icl_functions e_info heaps cs
......@@ -2831,28 +2831,31 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
(Yes symbol_type) = inst_def.fun_type
= { instance_defs & [ds_index] = { inst_def & fun_type = Yes (makeElemTypeOfArrayFunctionStrict symbol_type ins_offset offset_table) } }
check_needed_modules_are_imported mod_name extension e_info cs=:{cs_needed_modules}
# (e_info, cs) = case cs_needed_modules bitand cNeedStdDynamics of
0 -> (e_info, cs)
_ -> check_it PD_StdDynamics mod_name extension e_info cs
# (e_info, cs) = case cs_needed_modules bitand cNeedStdArray of
0 -> (e_info, cs)
_ -> check_it PD_StdArray mod_name extension e_info cs
# (e_info, cs) = case cs_needed_modules bitand cNeedStdEnum of
0 -> (e_info, cs)
_ -> check_it PD_StdEnum mod_name extension e_info cs
= (e_info, cs)
check_needed_modules_are_imported mod_name extension cs=:{cs_needed_modules}
# cs = case cs_needed_modules bitand cNeedStdDynamics of
0 -> cs
_ -> check_it PD_StdDynamics mod_name extension cs
# cs = case cs_needed_modules bitand cNeedStdArray of
0 -> cs
_ -> check_it PD_StdArray mod_name extension cs
# cs = case cs_needed_modules bitand cNeedStdEnum of
0 -> cs
_ -> check_it PD_StdEnum mod_name extension cs
= cs
where
check_it pd mod_name extension e_info=:{ef_modules} cs=:{cs_predef_symbols}
check_it pd mod_name extension cs=:{cs_predef_symbols, cs_symbol_table}
#! {pds_ident} = cs_predef_symbols.[pd]
is_imported = any ((==) pds_ident) [ dcl_name \\ {dcl_name}<-:ef_modules ]
| is_imported
= (e_info, cs)
# error_location = { ip_ident = mod_name, ip_line = 1, ip_file = mod_name.id_name+++extension}
cs_error = pushErrorAdmin error_location cs.cs_error
cs_error = checkError pds_ident "not imported" cs_error
cs_error = popErrorAdmin cs_error
= (e_info, { cs & cs_error = cs_error })
# ({ste_kind}, cs_symbol_table) = readPtr pds_ident.id_info cs_symbol_table
cs = { cs & cs_symbol_table = cs_symbol_table }
= case ste_kind of
STE_ClosedModule
-> cs
STE_Empty
# error_location = { ip_ident = mod_name, ip_line = 1, ip_file = mod_name.id_name+++extension}
cs_error = pushErrorAdmin error_location cs.cs_error
cs_error = checkError pds_ident "not imported" cs_error
cs_error = popErrorAdmin cs_error
-> { cs & cs_error = cs_error }
arrayFunOffsetToPD_IndexTable :: !{# MemberDef} !v:{# PredefinedSymbol} -> (!{# Index}, !{#MemberDef}, !v:{#PredefinedSymbol})
arrayFunOffsetToPD_IndexTable member_defs predef_symbols
......@@ -2992,7 +2995,7 @@ checkDclModule {mod_name,mod_imports,mod_defs} mod_index modules icl_functions h
(icl_functions, e_info, heaps, cs)
= checkMacros mod_index dcl_macros icl_functions e_info heaps { cs & cs_error = cs_error }
(e_info, cs) = check_needed_modules_are_imported mod_name ".dcl" e_info cs
cs = check_needed_modules_are_imported mod_name ".dcl" cs
com_instance_defs = dcl_common.com_instance_defs
com_instance_defs = { inst_def \\ inst_def <- [ inst_def \\ inst_def <-: com_instance_defs ] ++ new_class_instances }
......
......@@ -409,6 +409,8 @@ instance t_corresponds AType where
= t_corresponds_at_type dclDef iclDef
where
t_corresponds_at_type dclDef iclDef tc_state
| dclDef.at_annotation<>iclDef.at_annotation
= (False, tc_state)
# (corresponds, tc_state) = simple_corresponds dclDef iclDef tc_state
| corresponds
= (corresponds, tc_state)
......@@ -419,13 +421,13 @@ instance t_corresponds AType where
#! x = sreadPtr tv_info_ptr tc_state.tc_type_vars.hwn_heap
-> case x of
TVI_AType dcl_atype
-> t_corresponds dcl_atype iclDef tc_state
-> t_corresponds { dcl_atype & at_annotation = dclDef.at_annotation } iclDef tc_state
_ -> (False, tc_state)
_ -> (False, tc_state)
where
simple_corresponds dclDef iclDef
= t_corresponds dclDef.at_attribute iclDef.at_attribute
&&& equal dclDef.at_annotation iclDef.at_annotation
&&& t_corresponds dclDef.at_type iclDef.at_type
corresponds_with_expanded_syn_type {glob_module, glob_object} dclArgs icl_atype
......@@ -472,7 +474,7 @@ instance t_corresponds AType where
# (actual_arg, type_var_heap) = possibly_dereference actual_arg type_var_heap
= bind_type_vars` formal_args actual_args
(writePtr atv_variable.tv_info_ptr (TVI_AType actual_arg) type_var_heap)
// --->("binding", atv_variable.tv_name,"to",actual_arg)
// --->("binding", atv_variable.tv_name,"to",actual_arg)
bind_type_vars` _ _ type_var_heap
= type_var_heap
......
......@@ -783,8 +783,8 @@ instance consequences Expression
instance consequences FunctionBody
where consequences (CheckedBody body) = consequences body
consequences (TransformedBody body) = consequences body
consequences (RhsMacroBody body) = consequences body
// other alternatives should not occur
instance consequences FunType
where
consequences {ft_type} = consequences ft_type
......
......@@ -22,6 +22,7 @@ frontEndInterface :: !Ident !SearchPaths !*PredefinedSymbols !*HashTable !*Files
frontEndInterface mod_ident search_paths predef_symbols hash_table files error io out
# (ok, mod, hash_table, error, predef_symbols, files)
= wantModule cWantIclFile mod_ident (hash_table ---> ("Parsing:", mod_ident)) error search_paths predef_symbols files
#! mod_type = mod.mod_type
| not ok
= (predef_symbols, hash_table, files, error, io, out, No)
# (ok, mod, nr_of_global_funs, mod_functions, dcl_mod, predef_mod, modules, hash_table, error, predef_symbols, files)
......@@ -37,7 +38,7 @@ frontEndInterface mod_ident search_paths predef_symbols hash_table files error i
# {icl_functions,icl_instances,icl_specials,icl_common,icl_declared={dcls_import}} = icl_mod
// (components, icl_functions, error) = showComponents components 0 True icl_functions error
(ok, fun_defs, array_instances, type_code_instances, common_defs, imported_funs, heaps, predef_symbols, error)
= typeProgram (components -*-> "Typing") icl_functions icl_specials icl_common dcls_import dcl_mods heaps predef_symbols error
= typeProgram mod_type (components -*-> "Typing") icl_functions icl_specials icl_common dcls_import dcl_mods heaps predef_symbols error
| not ok
= (predef_symbols, hash_table, files, error, io, out, No)
......
module part
import StdEnv
import syntax, transform, checksupport, StdCompare, check, utilities
:: PartitioningInfo =
{ pi_marks :: !.{# Int}
, pi_next_num :: !Int
, pi_next_group :: !Int
, pi_groups :: ![[Int]]
, pi_deps :: ![Int]
}
NotChecked :== -1
Start = 3
partitionateFunctions :: !*{# FunDef} !*{# FunDef} -> (!{! Group}, !*{# FunDef}, !*{# FunDef})
partitionateFunctions fun_defs inst_defs
#! nr_of_functions = size fun_defs
nr_of_instances = size inst_defs
#! max_fun_nr = nr_of_functions + nr_of_instances
# partitioning_info = { pi_marks = createArray max_fun_nr NotChecked, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [] }
(fun_defs, inst_defs, {pi_groups,pi_next_group}) = partitionate_functions 0 max_fun_nr nr_of_functions fun_defs inst_defs partitioning_info
groups = { {group_members = group} \\ group <- reverse pi_groups }
= (groups, fun_defs, inst_defs)
where
partitionate_functions :: !Int !Int !Int !*{# FunDef} !*{# FunDef} !*PartitioningInfo -> (!*{# FunDef}, !*{# FunDef}, !*PartitioningInfo)
partitionate_functions from_index max_fun_nr nr_of_functions fun_defs inst_defs pi=:{pi_marks}
| from_index == max_fun_nr
= (fun_defs, inst_defs, pi)
| pi_marks.[from_index] == NotChecked
# (_, fun_defs, inst_defs, pi) = partitionate_function from_index max_fun_nr nr_of_functions fun_defs inst_defs pi
= partitionate_functions (inc from_index) max_fun_nr nr_of_functions fun_defs inst_defs pi
= partitionate_functions (inc from_index) max_fun_nr nr_of_functions fun_defs inst_defs pi
partitionate_function :: !Int !Int !Int !*{# FunDef} !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*{# FunDef}, !*PartitioningInfo)
partitionate_function fun_index max_fun_nr nr_of_functions fun_defs inst_defs pi=:{pi_next_num}
| fun_index < nr_of_functions
#! fd = fun_defs.[fun_index]
| fd.fun_kind
# {fi_calls,fi_instance_calls} = fd.fun_info
(min_dep, fun_defs, inst_defs, pi) = visit_functions fi_calls max_fun_nr max_fun_nr nr_of_functions fun_defs inst_defs (push_on_dep_stack fun_index pi)
(min_dep, fun_defs, inst_defs, pi) = visit_functions fi_calls min_dep max_fun_nr nr_of_functions fun_defs inst_defs pi
= try_to_close_group fun_index pi_next_num min_dep max_fun_nr nr_of_functions fun_defs inst_defs pi
#! fd = inst_defs.[fun_index-nr_of_functions]
# {fi_calls,fi_instance_calls} = fd.fun_info
(min_dep, fun_defs, inst_defs, pi) = visit_functions fi_calls max_fun_nr max_fun_nr nr_of_functions fun_defs inst_defs (push_on_dep_stack fun_index pi)
(min_dep, fun_defs, inst_defs, pi) = visit_functions fi_calls min_dep max_fun_nr nr_of_functions fun_defs inst_defs pi
= try_to_close_group fun_index pi_next_num min_dep max_fun_nr nr_of_functions fun_defs inst_defs pi
push_on_dep_stack :: !Int !*PartitioningInfo -> *PartitioningInfo;
push_on_dep_stack fun_index pi=:{pi_deps,pi_marks,pi_next_num}
= { pi & pi_deps = [fun_index : pi_deps], pi_marks = { pi_marks & [fun_index] = pi_next_num}, pi_next_num = inc pi_next_num}
visit_functions :: ![FunCall] !Int !Int !Int !*{# FunDef} !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*{# FunDef}, !*PartitioningInfo)
visit_functions [{fc_index}:funs] min_dep max_fun_nr nr_of_functions fun_defs inst_defs pi=:{pi_marks}
#! mark = pi_marks.[fc_index]
| mark == NotChecked
# (mark, fun_defs, inst_defs, pi) = partitionate_function fc_index max_fun_nr nr_of_functions fun_defs inst_defs pi
= visit_functions funs (min min_dep mark) max_fun_nr nr_of_functions fun_defs inst_defs pi
= visit_functions funs (min min_dep mark) max_fun_nr nr_of_functions fun_defs inst_defs pi
visit_functions [] min_dep max_fun_nr nr_of_functions fun_defs inst_defs pi
= (min_dep, fun_defs, inst_defs, pi)
try_to_close_group :: !Int !Int !Int !Int !Int !*{# FunDef} !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*{# FunDef}, !*PartitioningInfo)
try_to_close_group fun_index fun_nr min_dep max_fun_nr nr_of_functions fun_defs inst_defs pi=:{pi_marks, pi_deps, pi_groups, pi_next_group}
| fun_nr <= min_dep
# (pi_deps, pi_marks, group, fun_defs, inst_defs)
= close_group fun_index pi_deps pi_marks [] max_fun_nr nr_of_functions pi_next_group fun_defs inst_defs
pi = { pi & pi_deps = pi_deps, pi_marks = pi_marks, pi_next_group = inc pi_next_group, pi_groups = [group : pi_groups] }
= (max_fun_nr, fun_defs, inst_defs, pi)
= (min_dep, fun_defs, inst_defs, pi)
where
close_group :: !Int ![Int] !*{# Int} ![Int] !Int !Int !Index !*{# FunDef} !*{# FunDef} -> (![Int], !*{# Int}, ![Int], !*{# FunDef}, !*{# FunDef})
close_group fun_index [d:ds] marks group max_fun_nr nr_of_functions group_number fun_defs inst_defs
#! fd = fun_defs.[d]
# marks = { marks & [d] = max_fun_nr }
| d < nr_of_functions
#! fd = fun_defs.[d]
# fun_defs = { fun_defs & [d] = { fd & fun_info.fi_group_index = group_number }}
| d == fun_index
= (ds, marks, [d : group], fun_defs, inst_defs)
= close_group fun_index ds marks group max_fun_nr nr_of_functions group_number fun_defs inst_defs
#! fd = inst_defs.[d-nr_of_functions]
# inst_defs = { inst_defs & [d] = { fd & fun_info.fi_group_index = group_number }}
| d == fun_index
= (ds, marks, [d : group], fun_defs, inst_defs)
= close_group fun_index ds marks group max_fun_nr nr_of_functions group_number fun_defs inst_defs
......@@ -549,9 +549,9 @@ partitionateMacros {ir_from,ir_to} mod_index fun_defs modules var_heap symbol_he
# partitioning_info = { pi_var_heap = var_heap, pi_symbol_heap = symbol_heap,
pi_symbol_table = symbol_table,
pi_error = error, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [] }
(fun_defs, modules, {pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_error, pi_next_group, pi_groups, pi_marks})
(fun_defs, modules, {pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_error, pi_next_group, pi_groups, pi_marks, pi_deps})
= iFoldSt (pationate_macro mod_index max_fun_nr) ir_from ir_to (fun_defs, modules, partitioning_info)
= (iFoldSt reset_body_of_rhs_macro ir_from ir_to fun_defs, modules, pi_var_heap, pi_symbol_heap, pi_symbol_table, pi_error)
= (foldSt reset_body_of_rhs_macro pi_deps fun_defs, modules, pi_var_heap, pi_symbol_heap, pi_symbol_table, pi_error)
where
reset_body_of_rhs_macro macro_index macro_defs
......@@ -592,6 +592,7 @@ where
fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = local_vars }}
= ({ macro_defs & [macro_index] = macro }, modules,
{ pi & pi_symbol_table = es_symbol_table, pi_symbol_heap = es_symbol_heap, pi_var_heap = es_var_heap, pi_error = es_error })
# pi = { pi & pi_deps = [macro_index:pi.pi_deps] }
= ({ macro_defs & [macro_index] = { macro & fun_body = RhsMacroBody body }}, modules, pi)
macros_are_simple [] macro_defs
......
......@@ -3,6 +3,7 @@ definition module type
import StdArray
import syntax, check
typeProgram ::!{! Group} !*{# FunDef} !IndexRange !CommonDefs ![Declaration] !{# DclModule} !*Heaps !*PredefinedSymbols !*File
// MW0 typeProgram ::!{! Group} !*{# FunDef} !IndexRange !CommonDefs ![Declaration] !{# DclModule} !*Heaps !*PredefinedSymbols !*File
typeProgram :: !ModuleKind !{! Group} !*{# FunDef} !IndexRange !CommonDefs ![Declaration] !{# DclModule} !*Heaps !*PredefinedSymbols !*File
-> (!Bool, !*{# FunDef}, !IndexRange, {! GlobalTCType}, !{# CommonDefs}, !{# {# FunType} }, !*Heaps, !*PredefinedSymbols, !*File)
......@@ -1371,9 +1371,11 @@ addLiftedArgumentsToSymbolType st=:{st_arity,st_args,st_vars,st_attr_vars,st_con
, fe_location :: !IdentPos
}
typeProgram ::!{! Group} !*{# FunDef} !IndexRange !CommonDefs ![Declaration] !{# DclModule} !*Heaps !*PredefinedSymbols !*File
// MW0 was typeProgram ::!{! Group} !*{# FunDef} !IndexRange !CommonDefs ![Declaration] !{# DclModule} !*Heaps !*PredefinedSymbols !*File
typeProgram :: !ModuleKind !{! Group} !*{# FunDef} !IndexRange !CommonDefs ![Declaration] !{# DclModule} !*Heaps !*PredefinedSymbols !*File
-> (!Bool, !*{# FunDef}, !IndexRange, {! GlobalTCType}, !{# CommonDefs}, !{# {# FunType} }, !*Heaps, !*PredefinedSymbols, !*File)
typeProgram comps fun_defs specials icl_defs imports modules {hp_var_heap, hp_expression_heap, hp_type_heaps} predef_symbols file
// MW0 was typeProgram comps fun_defs specials icl_defs imports modules {hp_var_heap, hp_expression_heap, hp_type_heaps} predef_symbols file
typeProgram mod_type comps fun_defs specials icl_defs imports modules {hp_var_heap, hp_expression_heap, hp_type_heaps} predef_symbols file
#! fun_env_size = size fun_defs
# ts_error = {ea_file = file, ea_loc = [], ea_ok = True }
......@@ -1393,11 +1395,18 @@ typeProgram comps fun_defs specials icl_defs imports modules {hp_var_heap, hp_ex
ts_type_heaps = { hp_type_heaps & th_vars = th_vars }, ts_td_infos = td_infos, ts_error = ts_error }
ti = { ti_common_defs = ti_common_defs, ti_functions = ti_functions }
special_instances = { si_next_array_member_index = fun_env_size, si_array_instances = [], si_next_TC_member_index = 0, si_TC_instances = [] }
# (type_error, fun_defs, predef_symbols, special_instances, ts) = type_components 0 comps class_instances ti (False, fun_defs, predef_symbols, special_instances, ts)
(fun_defs,ts_fun_env) = update_function_types 0 comps ts.ts_fun_env fun_defs
// MW0 was # (type_error, fun_defs, predef_symbols, special_instances, ts) = type_components 0 comps class_instances ti (False, fun_defs, predef_symbols, special_instances, ts)
(type_error, fun_defs, predef_symbols, special_instances, ts=:{ts_error})
= type_components 0 comps class_instances ti (False, fun_defs, predef_symbols, special_instances, ts)
// MW0 was (fun_defs,ts_fun_env) = update_function_types 0 comps ts.ts_fun_env fun_defs
(fun_defs, ts_fun_env, ts_error=:{ea_ok=no_start_rule_error}) = update_function_types 0 comps ts.ts_fun_env fun_defs ts_error
(type_error, fun_defs, predef_symbols, special_instances, {ts_fun_env,ts_error,ts_var_heap, ts_expr_heap, ts_type_heaps})
= type_instances specials.ir_from specials.ir_to class_instances ti (type_error, fun_defs, predef_symbols, special_instances,
{ ts & ts_fun_env = ts_fun_env })
// MW0 was = type_instances specials.ir_from specials.ir_to class_instances ti (type_error, fun_defs, predef_symbols, special_instances,
// MW0 was { ts & ts_fun_env = ts_fun_env })
= type_instances specials.ir_from specials.ir_to class_instances ti
(type_error || not no_start_rule_error, fun_defs, predef_symbols, special_instances,
{ ts & ts_fun_env = ts_fun_env, ts_error = { ts_error & ea_ok = True }})
{si_array_instances, si_next_array_member_index, si_next_TC_member_index, si_TC_instances}= special_instances
(fun_defs, predef_symbols, ts_type_heaps) = convert_array_instances si_array_instances ti_common_defs fun_defs predef_symbols ts_type_heaps
type_code_instances = {createArray si_next_TC_member_index GTT_Function & [gtci_index] = gtci_type \\ {gtci_index, gtci_type} <- si_TC_instances}
......@@ -1654,31 +1663,49 @@ where
= (subst, ts_fun_env)
update_function_types :: !Index !{!Group} !*{!FunctionType} !*{#FunDef} -> (!*{#FunDef}, !*{!FunctionType})
update_function_types group_index comps fun_env fun_defs
// MW0 was update_function_types :: !Index !{!Group} !*{!FunctionType} !*{#FunDef} -> (!*{#FunDef}, !*{!FunctionType})
update_function_types :: !Index !{!Group} !*{!FunctionType} !*{#FunDef} !*ErrorAdmin -> (!*{#FunDef}, !*{!FunctionType}, !.ErrorAdmin)
update_function_types group_index comps fun_env fun_defs error_admin
| group_index == size comps
= (fun_defs, fun_env)
// MW0 was = (fun_defs, fun_env)
= (fun_defs, fun_env, error_admin)
#! comp = comps.[group_index]
# (fun_defs, fun_env) = update_function_types_in_component comp.group_members fun_env fun_defs
= update_function_types (inc group_index) comps fun_env fun_defs
// MW0 was # (fun_defs, fun_env) = update_function_types_in_component comp.group_members fun_env fun_defs
# (fun_defs, fun_env, error_admin) = update_function_types_in_component comp.group_members fun_env fun_defs error_admin
// MW0 was = update_function_types (inc group_index) comps fun_env fun_defs
= update_function_types (inc group_index) comps fun_env fun_defs error_admin
where
update_function_types_in_component :: ![Index] !*{!FunctionType} !*{#FunDef} -> (!*{#FunDef}, !*{!FunctionType})
update_function_types_in_component [ fun_index : funs ] fun_env fun_defs
// MW0 was update_function_types_in_component :: ![Index] !*{!FunctionType} !*{#FunDef} -> (!*{#FunDef}, !*{!FunctionType})
update_function_types_in_component :: ![Index] !*{!FunctionType} !*{#FunDef} !*ErrorAdmin
-> (!*{#FunDef}, !*{!FunctionType}, !.ErrorAdmin)
// MW0 was update_function_types_in_component [ fun_index : funs ] fun_env fun_defs
update_function_types_in_component [ fun_index : funs ] fun_env fun_defs error_admin
# (CheckedType checked_fun_type, fun_env) = fun_env![fun_index]
#! fd = fun_defs.[fun_index]
// MW0..
# is_start_rule = fd.fun_symb.id_name=="Start" && fd.fun_info.fi_def_level==1 && mod_type==MK_Main
error_admin = case is_start_rule of
False -> error_admin
_ -> check_type_of_start_rule fd checked_fun_type error_admin
// ..MW0
= case fd.fun_type of
No
-> update_function_types_in_component funs fun_env { fun_defs & [fun_index] = { fd & fun_type = Yes checked_fun_type }}
// MW0 was -> update_function_types_in_component funs fun_env { fun_defs & [fun_index] = { fd & fun_type = Yes checked_fun_type }}
-> update_function_types_in_component funs fun_env { fun_defs & [fun_index] = { fd & fun_type = Yes checked_fun_type }} error_admin
Yes fun_type
# nr_of_lifted_arguments = checked_fun_type.st_arity - fun_type.st_arity
| nr_of_lifted_arguments > 0
# fun_type = addLiftedArgumentsToSymbolType fun_type nr_of_lifted_arguments
checked_fun_type.st_args checked_fun_type.st_vars checked_fun_type.st_attr_vars checked_fun_type.st_context
-> update_function_types_in_component funs fun_env { fun_defs & [fun_index] = { fd & fun_type = Yes fun_type }}
-> update_function_types_in_component funs fun_env fun_defs
update_function_types_in_component [] fun_env fun_defs
= (fun_defs, fun_env)
// MW0 was -> update_function_types_in_component funs fun_env { fun_defs & [fun_index] = { fd & fun_type = Yes fun_type }}
-> update_function_types_in_component funs fun_env { fun_defs & [fun_index] = { fd & fun_type = Yes fun_type }} error_admin
// MW0 was -> update_function_types_in_component funs fun_env fun_defs
-> update_function_types_in_component funs fun_env fun_defs error_admin
// MW0 was update_function_types_in_component [] fun_env fun_defs
// MW0 was = (fun_defs, fun_env)
update_function_types_in_component [] fun_env fun_defs error_admin
= (fun_defs, fun_env, error_admin)
type_functions group ti cons_variables fun_defs ts
= mapSt (type_function ti) group (cons_variables, fun_defs, ts) // ((cons_variables, fun_defs, ts) ---> "[(") ---> ")]"
......@@ -1769,6 +1796,23 @@ where
CheckedType _
-> ts
// MW0..
check_type_of_start_rule fd checked_fun_type error_admin
| not (isEmpty checked_fun_type.st_context)
= checkErrorWithIdentPos (newPosition fd.fun_symb fd.fun_pos) "must not be overloaded" error_admin
| isEmpty checked_fun_type.st_args
= error_admin
| length checked_fun_type.st_args > 1
= checkErrorWithIdentPos (newPosition fd.fun_symb fd.fun_pos) "should have arity 0 or 1" error_admin
= case checked_fun_type.st_args of
[] -> error_admin
[{at_type=TB BT_World}]
-> error_admin
[{at_type=TV _}]
-> error_admin
_ -> checkErrorWithIdentPos (newPosition fd.fun_symb fd.fun_pos) "argument must be of type World" error_admin
// ..MW0
instance <<< AttrCoercion
where
(<<<) file {ac_demanded,ac_offered} = file <<< ac_demanded <<< '~' <<< ac_offered
......
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