Skip to content
GitLab
Commit 86d417d0 authored by Martijn Vervoort's avatar Martijn Vervoort
Browse files

Normalizing 

- type variables
- passing a list of directly imported dcl modules by an icl modules
parent c0868c92
Hide whitespace changes
Inline Side-by-side
frontend/check.dcl
View file @ 86d417d0
......@@ -5,7 +5,7 @@ import syntax, transform, checksupport, typesupport, predef
cPredefinedModuleIndex :== 1
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)
-> (!Bool, *IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !.{#FunDef},!Int, !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File /* TD */, [String])
checkFunctions :: !Index !Level !Index !Index !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef}, !*ExpressionInfo, !*Heaps, !*CheckState)
......
frontend/check.icl
View file @ 86d417d0
......@@ -580,7 +580,7 @@ checkCommonDefinitions :: !Bool !Index !*CommonDefs !*{# DclModule} !*TypeHeaps
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 is_main_dcl_mod common.com_type_defs module_index
= checkTypeDefs /* TD */ is_dcl 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
......@@ -893,6 +893,18 @@ where
(<=<) infixl
(<=<) state fun :== fun state
// TD ...
retrieve_directly_imported_dcl_modules dependencies_of_icl_mod dcl_modules
# (directly_imported_dcl_modules,dcl_modules)
= mapSt retrieve_directly_import_dcl_module dependencies_of_icl_mod dcl_modules
= (directly_imported_dcl_modules,dependencies_of_icl_mod,dcl_modules)
where
retrieve_directly_import_dcl_module index dcl_modules=:{[index] = dcl_module}
# directly_imported_dcl_module
= dcl_module.dcl_name.id_name
= (directly_imported_dcl_module,dcl_modules)
// ... TD
checkDclModules imports_of_icl_mod dcl_modules icl_functions heaps cs=:{cs_symbol_table}
#! nr_of_dcl_modules
= size dcl_modules
......@@ -904,13 +916,17 @@ checkDclModules imports_of_icl_mod dcl_modules icl_functions heaps cs=:{cs_symbo
= nr_of_dcl_modules
(dependencies_of_icl_mod, (_, cs_symbol_table))
= mapFilterYesSt get_opt_dependency imports_of_icl_mod (bitvect, cs_symbol_table)
// TD ...
(directly_imported_dcl_modules,dependencies_of_icl_mod,dcl_modules)
= retrieve_directly_imported_dcl_modules dependencies_of_icl_mod dcl_modules
// ... TD
dependencies
= { dependencies & [index_of_icl_module] = dependencies_of_icl_mod }
module_dag
= { dag_nr_of_nodes = nr_of_dcl_modules+1, dag_get_children = select dependencies }
components
= partitionateDAG module_dag [cs.cs_x.x_main_dcl_module_n,index_of_icl_module]
// | False--->("biggest component:", maxList (map length components))
// | False--->("biggest component:", m axList (map length components))
// = undef
# (nr_of_components, component_numbers)
= getComponentNumbers components module_dag.dag_nr_of_nodes
......@@ -934,7 +950,7 @@ checkDclModules imports_of_icl_mod dcl_modules icl_functions heaps cs=:{cs_symbo
\\ expl_imp_symbols_in_component<-expl_imp_symbols_in_components }
// eii_declaring_modules will be updated later
cs
= { cs & cs_symbol_table = cs_symbol_table } // --->("expl_imp_symbols_in_components", expl_imp_symbols_in_components)
= { cs & cs_symbol_table = cs_symbol_table /* TD ... */ ,cs_x = { cs.cs_x & directly_imported_dcl_modules = directly_imported_dcl_modules} /* ... TD */ } // --->("expl_imp_symbols_in_components", expl_imp_symbols_in_components)
nr_of_icl_component
= component_numbers.[index_of_icl_module]
(_, expl_imp_infos, dcl_modules, icl_functions, heaps, cs)
......@@ -1228,8 +1244,8 @@ checkDclModuleWithinComponent dcl_imported_module_numbers component_nr is_on_cyc
{ cs & cs_symbol_table = cs_symbol_table }
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 :: !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 /* TD */, [String])
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
// | False--->("checkModule", m.mod_name)
// = undef
......@@ -1241,6 +1257,8 @@ checkModule m icl_global_function_range fun_defs n_functions_and_macros_in_dcl_m
# (mod_name,mod_imported_objects,mod_imports,mod_type,icl_global_function_range,nr_of_functions,first_inst_index,local_defs,icl_functions,init_dcl_modules,main_dcl_module_n,cdefs,sizes,cs)
= check_module1 m icl_global_function_range fun_defs optional_dcl_mod optional_pre_def_mod scanned_modules dcl_modules functions_and_macros dcl_module_n_in_cache predef_symbols symbol_table err_file
# icl_instance_range = {ir_from = first_inst_index, ir_to = nr_of_functions}
// llslsls CheckState
= check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_function_range icl_instance_range nr_of_functions n_functions_and_macros_in_dcl_modules optional_pre_def_mod local_defs icl_functions init_dcl_modules cdefs sizes heaps cs
check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs} icl_global_function_range fun_defs optional_dcl_mod optional_pre_def_mod scanned_modules dcl_modules functions_and_macros dcl_module_n_in_cache predef_symbols symbol_table err_file
......@@ -1261,7 +1279,7 @@ check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cde
(icl_functions, (sizes, local_defs)) = collectMacros cdefs.def_macros icl_functions sizes_and_local_defs
main_dcl_module_n = if (dcl_module_n_in_cache<>NoIndex) dcl_module_n_in_cache (size dcl_modules)
cs = { cs_symbol_table = symbol_table, cs_predef_symbols = predef_symbols, cs_error = error, cs_x= {x_needed_modules=0,x_main_dcl_module_n=main_dcl_module_n}}
cs = { cs_symbol_table = symbol_table, cs_predef_symbols = predef_symbols, cs_error = error, cs_x= {x_needed_modules=0,x_main_dcl_module_n=main_dcl_module_n /* TD */, x_is_dcl_module = False, x_type_var_position = 0, directly_imported_dcl_modules = []}}
(scanned_modules, icl_functions, cs) = add_dcl_module_predef_module_and_modules_to_symbol_table optional_dcl_mod optional_pre_def_mod scanned_modules (size dcl_modules) icl_functions cs
......@@ -1395,7 +1413,7 @@ check_module2 :: Ident [.ImportedObject] .[Import ImportDeclaration] .ModuleKind
(Optional (Module a)) [Declaration] *{#FunDef} *{#DclModule} (CollectedDefinitions ClassInstance IndexRange)
*{#.Int} *Heaps *CheckState
-> (!Bool,.IclModule,!.{#DclModule},.{!Group},!Optional {#Int},!.{#FunDef},!Int,!.Heaps,!.{#PredefinedSymbol},
!.Heap SymbolTableEntry,!.File);
!.Heap SymbolTableEntry,!.File,[String]);
check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_function_range icl_instance_range nr_of_functions n_functions_and_macros_in_dcl_modules optional_pre_def_mod local_defs icl_functions init_dcl_modules cdefs sizes heaps cs
# (main_dcl_module_n,cs)=cs!cs_x.x_main_dcl_module_n
(icl_sizes_without_added_dcl_defs, sizes) = memcpy sizes
......@@ -1416,7 +1434,7 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func
= checkDclModules mod_imports dcl_modules icl_functions heaps cs
| not cs.cs_error.ea_ok
= (False, abort "evaluated error 1 (check.icl)", {}, {}, No, {}, cs.cs_x.x_main_dcl_module_n,heaps, cs.cs_predef_symbols, cs.cs_symbol_table, cs.cs_error.ea_file)
= (False, abort "evaluated error 1 (check.icl)", {}, {}, No, {}, cs.cs_x.x_main_dcl_module_n,heaps, cs.cs_predef_symbols, cs.cs_symbol_table, cs.cs_error.ea_file /* TD */, [])
# (imported_module_numbers, dcl_modules)
= foldSt compute_used_module_nrs
expl_imp_indices
......@@ -1496,7 +1514,7 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func
cs = check_start_rule mod_type mod_name icl_global_function_range cs
cs = check_needed_modules_are_imported mod_name ".icl" cs
(icl_functions, e_info, heaps, {cs_symbol_table, cs_predef_symbols, cs_error,cs_x})
(icl_functions, e_info, heaps, {cs_symbol_table, cs_predef_symbols, cs_error,cs_x })
= checkInstanceBodies icl_instance_range icl_functions e_info heaps cs
cs_symbol_table = removeDeclarationsFromSymbolTable local_defs cGlobalScope cs_symbol_table
......@@ -1541,7 +1559,7 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func
= compareDefImp icl_sizes_without_added_dcl_defs untransformed_fun_bodies main_dcl_module_n
unexpanded_icl_type_defs main_dcl_module icl_mod heaps cs_error
= (cs_error.ea_ok, icl_mod, dcl_modules, groups, dcl_icl_conversions, cached_functions_and_macros, cs_x.x_main_dcl_module_n, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file)
= (cs_error.ea_ok, icl_mod, dcl_modules, groups, dcl_icl_conversions, cached_functions_and_macros, cs_x.x_main_dcl_module_n, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file /* TD */, cs_x.directly_imported_dcl_modules)
# icl_common = { icl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs,
com_cons_defs = e_info.ef_cons_defs, com_member_defs = e_info.ef_member_defs }
icl_mod = { icl_name = mod_name, icl_functions = icl_functions, icl_common = icl_common,
......@@ -1549,7 +1567,7 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func
icl_specials = {ir_from = nr_of_functions, ir_to = nr_of_functions},
icl_imported_objects = mod_imported_objects, icl_used_module_numbers = imported_module_numbers,
icl_import = icl_imported }
= (False, icl_mod, dcl_modules, {}, No, {}, cs_x.x_main_dcl_module_n,heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file)
= (False, icl_mod, dcl_modules, {}, No, {}, cs_x.x_main_dcl_module_n,heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file /* TD */, cs_x.directly_imported_dcl_modules)
where
check_start_rule mod_kind mod_name {ir_from, ir_to} cs=:{cs_predef_symbols,cs_symbol_table,cs_x}
# (pre_symb, cs_predef_symbols) = cs_predef_symbols![PD_Start]
......
frontend/checksupport.dcl
View file @ 86d417d0
......@@ -28,7 +28,7 @@ cNeedStdDynamics:== 4
:: CheckState = { cs_symbol_table :: !.SymbolTable, cs_predef_symbols :: !.PredefinedSymbols, cs_error :: !.ErrorAdmin,cs_x :: !CheckStateX }
:: CheckStateX = {x_needed_modules :: !BITVECT,x_main_dcl_module_n :: !Int }
:: CheckStateX = {x_needed_modules :: !BITVECT,x_main_dcl_module_n :: !Int /* TD */, x_is_dcl_module :: !Bool, x_type_var_position :: !Int, directly_imported_dcl_modules :: [String] }
// SymbolTable :== {# SymbolTableEntry}
......
frontend/checksupport.icl
View file @ 86d417d0
......@@ -33,7 +33,7 @@ cNeedStdDynamics:== 4
:: CheckState = { cs_symbol_table :: !.SymbolTable, cs_predef_symbols :: !.PredefinedSymbols, cs_error :: !.ErrorAdmin, cs_x :: !CheckStateX }
:: CheckStateX = {x_needed_modules :: !BITVECT,x_main_dcl_module_n :: !Int }
:: CheckStateX = {x_needed_modules :: !BITVECT,x_main_dcl_module_n :: !Int /* TD */, x_is_dcl_module :: !Bool, x_type_var_position :: !Int, directly_imported_dcl_modules :: [String] }
:: ConversionTable :== {# .{# Int }}
......
frontend/checktypes.dcl
View file @ 86d417d0
......@@ -2,7 +2,7 @@ definition module checktypes
import checksupport, typesupport
checkTypeDefs :: !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)
checkSymbolType :: !Index !SymbolType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
......
frontend/checktypes.icl
View file @ 86d417d0
......@@ -59,20 +59,19 @@ where
= True
try_to_combine_attributes _ _
= False
instance bindTypes TypeVar
where
bindTypes cti tv=:{tv_name=var_id=:{id_info}} (ts, ti, cs=:{cs_symbol_table})
bindTypes cti tv=:{tv_name=var_id=:{id_info}} (ts, ti, cs=:{cs_symbol_table /* TD ... */, cs_x={x_type_var_position,x_is_dcl_module} /* ... TD */ })
# (var_def, cs_symbol_table) = readPtr id_info cs_symbol_table
cs = { cs & cs_symbol_table = cs_symbol_table }
= case var_def.ste_kind of
STE_BoundTypeVariable bv=:{stv_attribute, stv_info_ptr, stv_count}
STE_BoundTypeVariable bv=:{stv_attribute, stv_info_ptr, stv_count /* TD */, stv_position}
# cs = { cs & cs_symbol_table = cs.cs_symbol_table <:= (id_info, { var_def & ste_kind = STE_BoundTypeVariable { bv & stv_count = inc stv_count }})}
-> ({ tv & tv_info_ptr = stv_info_ptr }, stv_attribute, (ts, ti, cs))
-> ({ tv & tv_info_ptr = stv_info_ptr /* TD ... */, tv_name = if x_is_dcl_module tv.tv_name { tv.tv_name & id_name = toString stv_position } /* ... TD */ }, stv_attribute, (ts, ti, cs))
_
-> (tv, TA_Multi, (ts, ti, { cs & cs_error = checkError var_id "undefined" cs.cs_error }))
instance bindTypes [a] | bindTypes a
where
bindTypes cti [] ts_ti_cs
......@@ -162,17 +161,18 @@ where
# (types, local_vars_list, attr_env, ts_ti_cs)
= bind_types_of_cons types cti free_vars attr_env ts_ti_cs
(type, type_attr, (ts, ti, cs)) = bindTypes cti type ts_ti_cs
(local_vars, cs_symbol_table) = foldSt retrieve_local_vars free_vars ([], cs.cs_symbol_table)
(local_vars, cs_symbol_table /* TD ... */, _ /* ... TD */ ) = foldSt retrieve_local_vars free_vars ([], cs.cs_symbol_table /* TD ...*/, cs.cs_x /* ... TD */ )
(attr_env, cs_error) = addToAttributeEnviron type_attr cti.cti_lhs_attribute attr_env cs.cs_error
= ([type : types], [local_vars : local_vars_list], attr_env, (ts, ti , { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error }))
where
retrieve_local_vars tv=:{tv_name={id_info}} (local_vars, symbol_table)
# (ste=:{ste_kind = STE_BoundTypeVariable bv=:{stv_attribute, stv_info_ptr, stv_count}}, symbol_table) = readPtr id_info symbol_table
retrieve_local_vars tv=:{tv_name={id_info}} (local_vars, symbol_table /* TD ... */, cs_x=:{x_is_dcl_module} /* ... TD */ )
# (ste=:{ste_kind = STE_BoundTypeVariable bv=:{stv_attribute, stv_info_ptr, stv_count /* TD ... */,stv_position /* ... TD */ }}, symbol_table) = readPtr id_info symbol_table
| stv_count == 0
= (local_vars, symbol_table)
= ([{ atv_variable = { tv & tv_info_ptr = stv_info_ptr }, atv_attribute = stv_attribute, atv_annotation = AN_None } : local_vars],
symbol_table <:= (id_info, { ste & ste_kind = STE_BoundTypeVariable { bv & stv_count = 0}}))
= (local_vars, symbol_table /* TD ... */, cs_x /* ... TD */)
= ([{ atv_variable = { tv & tv_info_ptr = stv_info_ptr /* TD ... */, tv_name = if x_is_dcl_module tv.tv_name { tv.tv_name & id_name = toString stv_position } /* ... TD */ }, atv_attribute = stv_attribute, atv_annotation = AN_None } : local_vars],
symbol_table <:= (id_info, { ste & ste_kind = STE_BoundTypeVariable { bv & stv_count = 0}})/* TD ... */, cs_x /* ... TD */)
//
checkRhsOfTypeDef :: !CheckedTypeDef ![AttributeVar] !CurrentTypeInfo !(!*TypeSymbols, !*TypeInfo, !*CheckState)
-> (!TypeRhs, !(!*TypeSymbols, !*TypeInfo, !*CheckState))
......@@ -227,10 +227,20 @@ isATopConsVar cv :== cv < 0
encodeTopConsVar cv :== dec (~cv)
decodeTopConsVar cv :== ~(inc cv)
checkTypeDef :: !Index !Index !*TypeSymbols !*TypeInfo !*CheckState -> (!*TypeSymbols, !*TypeInfo, !*CheckState);
checkTypeDef type_index module_index ts=:{ts_type_defs} ti=:{ti_type_heaps} cs=:{cs_error}
checkTypeDef :: /* TD */ !Bool !Index !Index !*TypeSymbols !*TypeInfo !*CheckState -> (!*TypeSymbols, !*TypeInfo, !*CheckState);
checkTypeDef /* TD */ is_dcl_module type_index module_index ts=:{ts_type_defs} ti=:{ti_type_heaps} cs=:{cs_error}
# (type_def, ts_type_defs) = ts_type_defs![type_index]
# {td_name,td_pos,td_args,td_attribute} = type_def
// TD ...
// in case of an icl-module, the arguments i.e. the type variables of type constructors are normalized which makes
// comparison by the static linker easier.
# (cs=:{cs_error})
= { cs & cs_x = { cs.cs_x & x_is_dcl_module = is_dcl_module, x_type_var_position = 0 } }
// | FB (not is_dcl_module) ("checkTypeDef: " +++ td_name.id_name) True
#
// ... TD
position = newPosition td_name td_pos
cs_error = pushErrorAdmin position cs_error
(td_attribute, attr_vars, th_attrs) = determine_root_attribute td_attribute td_name.id_name ti_type_heaps.th_attrs
......@@ -242,7 +252,10 @@ checkTypeDef type_index module_index ts=:{ts_type_defs} ti=:{ti_type_heaps} cs=:
({ ts & ts_type_defs = ts_type_defs },{ ti & ti_type_heaps = ti_type_heaps}, cs)
= ({ ts & ts_type_defs = { ts.ts_type_defs & [type_index] = { type_def & td_rhs = td_rhs }}}, ti,
{ cs & cs_error = popErrorAdmin cs.cs_error,
cs_symbol_table = removeAttributedTypeVarsFromSymbolTable cOuterMostLevel type_vars cs.cs_symbol_table })
cs_symbol_table = removeAttributedTypeVarsFromSymbolTable cOuterMostLevel type_vars cs.cs_symbol_table
// TD ...
, cs_x = { cs.cs_x & x_is_dcl_module = False} })
// ... TD
where
determine_root_attribute TA_None name attr_var_heap
# (attr_info_ptr, attr_var_heap) = newPtr AVI_Empty attr_var_heap
......@@ -406,9 +419,9 @@ where
kind_list_to_string [k:ks] = " -> " +++ toString k +++ kind_list_to_string ks
*/
checkTypeDefs :: !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)
checkTypeDefs 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
#! nr_of_types = size type_defs
# ts = { ts_type_defs = type_defs, ts_cons_defs = cons_defs, ts_selector_defs = selector_defs, ts_modules = modules }
ti = { ti_type_heaps = type_heaps, ti_var_heap = var_heap }
......@@ -417,7 +430,7 @@ where
check_type_defs is_main_dcl type_index nr_of_types module_index ts ti=:{ti_type_heaps,ti_var_heap} cs
| type_index == nr_of_types
= (ts.ts_type_defs, ts.ts_cons_defs, ts.ts_selector_defs, ts.ts_modules, ti_var_heap, ti_type_heaps, cs)
# (ts, ti, cs) = checkTypeDef type_index module_index ts ti cs
# (ts, ti, cs) = checkTypeDef /* TD */ is_dcl_module type_index module_index ts ti cs
= check_type_defs is_main_dcl (inc type_index) nr_of_types module_index ts ti cs
expand_syn_types module_index type_index nr_of_types expst
......@@ -983,26 +996,54 @@ cOuterMostLevel :== 0
addTypeVariablesToSymbolTable :: ![ATypeVar] ![AttributeVar] !*TypeHeaps !*CheckState
-> (![ATypeVar], !(![AttributeVar], !*TypeHeaps, !*CheckState))
addTypeVariablesToSymbolTable type_vars attr_vars heaps cs
= mapSt (add_type_variable_to_symbol_table) type_vars (attr_vars, heaps, cs)
addTypeVariablesToSymbolTable type_vars attr_vars heaps cs /* TD */ =:{cs_x={x_type_var_position,x_is_dcl_module}}
// TD ...
| x_type_var_position <> 0 = abort "addTypeVariablesToSymbolTable: x_type_var_position must be zero-initialized"
# ((a_type_vars,t=:(attribute_vars, type_heaps, check_state)))
= mapSt (add_type_variable_to_symbol_table) type_vars (attr_vars, heaps, cs)
| x_is_dcl_module
= (a_type_vars,t)
// in case of an icl-module, the type variables of the type definition need to be normalized by storing its
// argument number for later use. To avoid incomprehensible error messages the constructor's type variables
// are changed below.
# (a_type_vars,check_state)
= mapSt change_type_variables_into_their_type_constructor_position a_type_vars check_state
= (a_type_vars,(attribute_vars, type_heaps, check_state))
// ... TD
where
// TD ...
change_type_variables_into_their_type_constructor_position :: !ATypeVar !*CheckState -> (!ATypeVar, !*CheckState)
change_type_variables_into_their_type_constructor_position atv=:{atv_variable=atv_variable=:{tv_name}, atv_attribute} cs=:{cs_symbol_table}
# tv_info = tv_name.id_info
(entry, cs_symbol_table) = readPtr tv_info cs_symbol_table
# stv_position
= case entry.ste_kind of
STE_BoundTypeVariable {stv_position}
-> stv_position
# atv
= { atv & atv_variable.tv_name.id_name = toString stv_position }
= (atv,{cs & cs_symbol_table = cs_symbol_table})
// ... TD
add_type_variable_to_symbol_table :: !ATypeVar !(![AttributeVar], !*TypeHeaps, !*CheckState)
-> (!ATypeVar, !(![AttributeVar], !*TypeHeaps, !*CheckState))
add_type_variable_to_symbol_table atv=:{atv_variable=atv_variable=:{tv_name}, atv_attribute}
(attr_vars, heaps=:{th_vars,th_attrs}, cs=:{ cs_symbol_table, cs_error })
(attr_vars, heaps=:{th_vars,th_attrs}, cs=:{ cs_symbol_table, cs_error /* TD ... */, cs_x={x_type_var_position} /* ... TD */})
# tv_info = tv_name.id_info
(entry, cs_symbol_table) = readPtr tv_info cs_symbol_table
(entry, cs_symbol_table) = readPtr tv_info cs_symbol_table
| entry.ste_def_level < cOuterMostLevel
# (tv_info_ptr, th_vars) = newPtr TVI_Empty th_vars
atv_variable = { atv_variable & tv_info_ptr = tv_info_ptr }
(atv_attribute, attr_vars, th_attrs, cs_error) = check_attribute atv_attribute tv_name.id_name attr_vars th_attrs cs_error
cs_symbol_table = cs_symbol_table <:= (tv_info, {ste_index = NoIndex, ste_kind = STE_BoundTypeVariable {stv_attribute = atv_attribute,
stv_info_ptr = tv_info_ptr, stv_count = 0 }, ste_def_level = cOuterMostLevel, ste_previous = entry })
stv_info_ptr = tv_info_ptr, stv_count = 0 /* TD */, stv_position = x_type_var_position}, ste_def_level = cOuterMostLevel, ste_previous = entry })
heaps = { heaps & th_vars = th_vars, th_attrs = th_attrs }
= ({atv & atv_variable = atv_variable, atv_attribute = atv_attribute},
(attr_vars, heaps, { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error }))
(attr_vars, heaps, { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error /* TD ... */, cs_x = {cs.cs_x & x_type_var_position = inc x_type_var_position} /* ... TD */}))
= (atv, (attr_vars, { heaps & th_vars = th_vars },
{ cs & cs_symbol_table = cs_symbol_table, cs_error = checkError tv_name.id_name " type variable already defined" cs_error}))
{ cs & cs_symbol_table = cs_symbol_table, cs_error = checkError tv_name.id_name " type variable already defined" cs_error /* TD ... */, cs_x = {cs.cs_x & x_type_var_position = inc x_type_var_position} /* ... TD */}))
check_attribute :: !TypeAttribute !String ![AttributeVar] !*AttrVarHeap !*ErrorAdmin
-> (!TypeAttribute, ![AttributeVar], !*AttrVarHeap, !*ErrorAdmin)
......@@ -1028,7 +1069,7 @@ where
add_type_variable_to_symbol_table :: !TypeAttribute !ATypeVar !(!*TypeHeaps, !*CheckState)
-> (!ATypeVar, !(!*TypeHeaps, !*CheckState))
add_type_variable_to_symbol_table root_attr atv=:{atv_variable=atv_variable=:{tv_name}, atv_attribute}
(heaps=:{th_vars,th_attrs}, cs=:{ cs_symbol_table, cs_error })
(heaps=:{th_vars,th_attrs}, cs=:{ cs_symbol_table, cs_error /* TD ... */, cs_x={x_type_var_position} /* ... TD */})
# tv_info = tv_name.id_info
(entry, cs_symbol_table) = readPtr tv_info cs_symbol_table
| entry.ste_def_level < cOuterMostLevel
......@@ -1036,12 +1077,12 @@ where
atv_variable = { atv_variable & tv_info_ptr = tv_info_ptr }
(atv_attribute, cs_error) = check_attribute atv_attribute root_attr tv_name.id_name cs_error
cs_symbol_table = cs_symbol_table <:= (tv_info, {ste_index = NoIndex, ste_kind = STE_BoundTypeVariable {stv_attribute = atv_attribute,
stv_info_ptr = tv_info_ptr, stv_count = 0 }, ste_def_level = cOuterMostLevel, ste_previous = entry })
stv_info_ptr = tv_info_ptr, stv_count = 0 /* TD */, stv_position = x_type_var_position }, ste_def_level = cOuterMostLevel, ste_previous = entry })
heaps = { heaps & th_vars = th_vars }
= ({atv & atv_variable = atv_variable, atv_attribute = atv_attribute},
(heaps, { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error }))
(heaps, { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error /* TD ... */, cs_x = {cs.cs_x & x_type_var_position = inc x_type_var_position} /* ... TD */ }))
= (atv, ({ heaps & th_vars = th_vars },
{ cs & cs_symbol_table = cs_symbol_table, cs_error = checkError tv_name.id_name " type variable already defined" cs_error}))
{ cs & cs_symbol_table = cs_symbol_table, cs_error = checkError tv_name.id_name " type variable already defined" cs_error /* TD ... */, cs_x = {cs.cs_x & x_type_var_position = inc x_type_var_position} /* ... TD */}))
check_attribute :: !TypeAttribute !TypeAttribute !String !*ErrorAdmin
-> (!TypeAttribute, !*ErrorAdmin)
......
frontend/convertDynamics.dcl
View file @ 86d417d0
......@@ -3,7 +3,7 @@ definition module convertDynamics
import syntax, transform, convertcases
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !Int !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap !*File {# DclModule} !IclModule
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !Int !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap !*File {# DclModule} !IclModule /* TD */ [String]
-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap, !*File)
/*
......
frontend/convertDynamics.icl
View file @ 86d417d0
......@@ -47,23 +47,27 @@ pl [x:xs] = x +++ " , " +++ (pl xs)
F :: !a .b -> .b
F a b = b
write_tcl_file :: !Int {#DclModule} CommonDefs !*File -> (.Bool,.File)
write_tcl_file main_dcl_module_n dcl_mods=:{[main_dcl_module_n] = main_dcl_module} common_defs tcl_file
write_tcl_file :: !Int {#DclModule} CommonDefs !*File [String] -> (.Bool,.File)
write_tcl_file main_dcl_module_n dcl_mods=:{[main_dcl_module_n] = main_dcl_module} common_defs tcl_file directly_imported_dcl_modules
#! tcl_file
= write_type_info common_defs tcl_file
= (True,tcl_file)
#! tcl_file
= write_type_info directly_imported_dcl_modules tcl_file
#! tcl_file
= fwritei (size main_dcl_module.dcl_common.com_type_defs) tcl_file
= (True,tcl_file)
//---> ("dcl",size main_dcl_module.dcl_common.com_type_defs, "icl", size common_defs.com_type_defs);
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !Int !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap /* TD */!*File {# DclModule} !IclModule
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !Int !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap /* TD */!*File {# DclModule} !IclModule /* TD */ [String]
-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap, /* TD */ !*File)
convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_module_n groups fun_defs predefined_symbols var_heap type_heaps expr_heap /* TD */ tcl_file dcl_mods icl_mod
convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_module_n groups fun_defs predefined_symbols var_heap type_heaps expr_heap /* TD */ tcl_file dcl_mods icl_mod /* TD */ directly_imported_dcl_modules
// TD ...
/*
# (ok,tcl_file)
= write_tcl_file main_dcl_module_n dcl_mods icl_mod.icl_common tcl_file
= write_tcl_file main_dcl_module_n dcl_mods icl_mod.icl_common tcl_file /* TD */ directly_imported_dcl_modules
| not ok
= abort "convertDynamicPatternsIntoUnifyAppls: error writing tcl file"
*/
// ... TD
# ({pds_module, pds_def} , predefined_symbols) = predefined_symbols![PD_StdDynamics]
#! (dynamic_temp_symb_ident,ci_sel_value_field,ci_sel_type_field,predefined_symbols)
= case (pds_module == (-1) || pds_def == (-1)) of
......
frontend/frontend.icl
View file @ 86d417d0
......@@ -89,7 +89,7 @@ frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_mac
| not ok
= (No,{},0,0,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
# symbol_table = hash_table.hte_symbol_heap
(ok, icl_mod, dcl_mods, components, optional_dcl_icl_conversions,cached_functions_and_macros,main_dcl_module_n,heaps, predef_symbols, symbol_table, error)
(ok, icl_mod, dcl_mods, components, optional_dcl_icl_conversions,cached_functions_and_macros,main_dcl_module_n,heaps, predef_symbols, symbol_table, error /* TD */, directly_imported_dcl_modules)
= checkModule mod global_fun_range mod_functions n_functions_and_macros_in_dcl_modules dcl_module_n_in_cache optional_dcl_mod modules dcl_modules functions_and_macros predef_symbols (symbol_table -*-> "Checking") error heaps
hash_table = { hash_table & hte_symbol_heap = symbol_table}
......@@ -137,7 +137,7 @@ frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_mac
# (components, fun_defs, predef_symbols, dcl_types, used_conses_in_dynamics, var_heap, type_heaps, expression_heap, tcl_file)
= convertDynamicPatternsIntoUnifyAppls type_code_instances common_defs main_dcl_module_n (components -*-> "convertDynamics") fun_defs predef_symbols
heaps.hp_var_heap heaps.hp_type_heaps heaps.hp_expression_heap tcl_file dcl_mods icl_mod
heaps.hp_var_heap heaps.hp_type_heaps heaps.hp_expression_heap tcl_file dcl_mods icl_mod /* TD */ directly_imported_dcl_modules
// # (components, fun_defs, error) = showComponents3 components 0 False fun_defs error
// (components, fun_defs, error) = showComponents components 0 True fun_defs error
......
frontend/syntax.dcl
View file @ 86d417d0
......@@ -33,7 +33,7 @@ instance toString Ident
, ste_previous :: SymbolTableEntry
}
:: STE_BoundTypeVariable = { stv_count :: !Int, stv_attribute :: !TypeAttribute, stv_info_ptr :: !TypeVarInfoPtr}
:: STE_BoundTypeVariable = { stv_count :: !Int, stv_attribute :: !TypeAttribute, stv_info_ptr :: !TypeVarInfoPtr /* TD */, stv_position :: Int }
:: STE_Kind = STE_FunctionOrMacro ![Index]
| STE_Type
......
frontend/syntax.icl
View file @ 86d417d0
......@@ -34,7 +34,7 @@ where toString {import_module} = toString import_module
, ste_previous :: SymbolTableEntry
}
:: STE_BoundTypeVariable = { stv_count :: !Int, stv_attribute :: !TypeAttribute, stv_info_ptr :: !TypeVarInfoPtr}
:: STE_BoundTypeVariable = { stv_count :: !Int, stv_attribute :: !TypeAttribute, stv_info_ptr :: !TypeVarInfoPtr /* TD */, stv_position :: Int }
:: STE_Kind = STE_FunctionOrMacro ![Index]
| STE_Type
......
frontend/type_io.dcl
View file @ 86d417d0
......@@ -8,7 +8,7 @@ class WriteTypeInfo a
where
write_type_info :: a !*File -> !*File
instance WriteTypeInfo CommonDefs
instance WriteTypeInfo CommonDefs, Char, [a] | WriteTypeInfo a
//1.3
instance WriteTypeInfo {#b} | select_u, size_u, WriteTypeInfo b
......
frontend/type_io.icl
View file @ 86d417d0
......@@ -13,6 +13,120 @@ F a b :== b;
// - abstract data type, what should be written?
//
// Records:
// - ordered fields
//
// Constructors:
// - unordered
/*
:: TypeRhs = AlgType ![DefinedSymbol]
| SynType !AType
| RecordType !RecordType
| AbstractType !BITVECT
| UnknownType
{ ds_ident :: !Ident
, ds_arity :: !Int
, ds_index :: !Index
}
:: RecordType =
{ rt_constructor :: !DefinedSymbol
, rt_fields :: !{# FieldSymbol}
}
:: FieldSymbol =
{ fs_name :: !Ident
, fs_var :: !Ident
, fs_index :: !Index
}
:: ConsDef =
{ cons_symb :: !Ident
, cons_type :: !SymbolType
, cons_arg_vars :: ![[ATypeVar]]
, cons_priority :: !Priority
, cons_index :: !Index
, cons_type_index :: !Index
, cons_exi_vars :: ![ATypeVar]
// , cons_exi_attrs :: ![AttributeVar]
, cons_type_ptr :: !VarInfoPtr
, cons_pos :: !Position
}
:: TypeDef type_rhs =
{ td_name :: !Ident
, td_index :: !Int
, td_arity :: !Int
, td_args :: ![ATypeVar]
, td_attrs :: ![AttributeVar]
, td_context :: ![TypeContext]
, td_rhs :: !type_rhs
, td_attribute :: !TypeAttribute
, td_pos :: !Position
}
*/
class NormaliseTypeDef a
where
normalise_type_def :: a -> a
import RWSDebug
instance NormaliseTypeDef TypeRhs
where
normalise_type_def (AlgType defined_symbols)
// algebraic data types are further normalized by an alphabetical sort on the
// constructor names.
= AlgType (sortBy (\{ds_ident={id_name=id_name1}} {ds_ident={id_name=id_name2}} -> id_name1 < id_name2) defined_symbols)
normalise_type_def i
= i
instance NormaliseTypeDef TypeDef rhs | NormaliseTypeDef rhs
where
normalise_type_def type_def=:{td_args,td_arity}
= type_def