Commit 79e9ad7b authored by John van Groningen's avatar John van Groningen
Browse files

unfold all macros and local functions in macros

changed Declaration type
fixed crash when macro appears only in dcl module
added make with caching in 'main'
use BoxedIdent in hashtable
parent e865e93c
......@@ -178,7 +178,7 @@ where
compare_arguments (App app1) (App app2) = app1 =< app2
compare_arguments (Var v1) (Var v2) = v1 =< v2
compare_arguments (fun1 @ args1) (fun2 @ args2) = (fun1,args1) =< (fun2,args2)
compare_arguments (Lambda vars1 expr1) (Lambda vars2 expr2) = (vars1,expr1) =< (vars2,expr2)
// compare_arguments (Lambda vars1 expr1) (Lambda vars2 expr2) = (vars1,expr1) =< (vars2,expr2)
compare_arguments EE EE = Equal
compare_arguments _ _ = Greater
| less_constructor expr1 expr2
......
implementation module analtypes
import StdEnv
import syntax, checksupport, checktypes, check, typesupport, utilities, analunitypes, RWSDebug
import syntax, checksupport, checktypes, check, typesupport, utilities, analunitypes //, RWSDebug
:: UnifyKindsInfo =
{ uki_kind_heap ::!.KindHeap
......
This diff is collapsed.
......@@ -522,6 +522,7 @@ where
(gs, pattern_scheme, pattern_variables, defaul, free_vars, e_state, e_info, cs)
= check_guarded_expressions free_vars gs pattern_variables case_name e_input e_state e_info cs
= check_guarded_expression free_vars g gs pattern_scheme pattern_variables defaul case_name e_input e_state e_info cs
check_guarded_expression free_vars {calt_pattern,calt_rhs={rhs_alts,rhs_locals}} patterns pattern_scheme pattern_variables defaul case_name
e_input=:{ei_expr_level,ei_mod_index} e_state=:{es_fun_defs,es_var_heap} e_info cs
# (pattern, (var_env, array_patterns), {ps_fun_defs,ps_var_heap}, e_info, cs)
......@@ -911,7 +912,6 @@ checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_stat
checkExpression free_vars expr e_input e_state e_info cs
= abort "checkExpression (checkFunctionBodies.icl, line 868)" // <<- expr
checkIdentExpression :: !Bool ![FreeVar] !Ident !ExpressionInput !*ExpressionState !u:ExpressionInfo !*CheckState
-> (!Expression, ![FreeVar], !*ExpressionState, !u:ExpressionInfo, !*CheckState)
checkIdentExpression is_expr_list free_vars id=:{id_info} e_input e_state e_info cs=:{cs_symbol_table}
......@@ -1883,23 +1883,6 @@ buildPattern mod_index APK_Macro {glob_object} args opt_var ps e_info=:{ef_modul
= (pattern, ps, { e_info & ef_modules = ef_modules, ef_cons_defs = ef_cons_defs }, { cs & cs_error = cs_error })
//////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////
getPredefinedGlobalSymbol :: !Index !Index !STE_Kind !Int !*CheckState -> (!Global DefinedSymbol, !*CheckState)
getPredefinedGlobalSymbol symb_index module_index req_ste_kind arity cs=:{cs_predef_symbols,cs_symbol_table}
# (pre_def_mod, cs_predef_symbols) = cs_predef_symbols![module_index]
......
......@@ -51,6 +51,9 @@ cConversionTableSize :== 9 // AA
:: CommonDefs =
{ com_type_defs :: !.{# CheckedTypeDef}
, com_unexpanded_type_defs :: !{# CheckedTypeDef}
, com_cons_defs :: !.{# ConsDef}
, com_selector_defs :: !.{# SelectorDef}
, com_class_defs :: !.{# ClassDef}
......
......@@ -5,7 +5,7 @@ import syntax, predef, containers
import utilities
from check import checkFunctions
import RWSDebug
//import RWSDebug
:: VarHeap :== Heap VarInfo
......@@ -65,6 +65,9 @@ where
:: CommonDefs =
{ com_type_defs :: !.{# CheckedTypeDef}
, com_unexpanded_type_defs :: !{# CheckedTypeDef}
, com_cons_defs :: !.{# ConsDef}
, com_selector_defs :: !.{# SelectorDef}
, com_class_defs :: !.{# ClassDef}
......@@ -230,9 +233,9 @@ convertIndex index table_index No
retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Index)
retrieveGlobalDefinition {ste_kind = STE_Imported kind dcl_index, ste_def_level, ste_index} requ_kind mod_index
retrieveGlobalDefinition {ste_kind = STE_Imported kind decl_index, ste_def_level, ste_index} requ_kind mod_index
| kind == requ_kind
= (ste_index, dcl_index)
= (ste_index, decl_index)
= (NotFound, mod_index)
retrieveGlobalDefinition {ste_kind,ste_def_level,ste_index} requ_kind mod_index
| ste_kind == requ_kind && ste_def_level == cGlobalScope
......@@ -241,9 +244,9 @@ retrieveGlobalDefinition {ste_kind,ste_def_level,ste_index} requ_kind mod_index
getBelongingSymbols :: !Declaration !v:{#DclModule} -> (!BelongingSymbols, !v:{#DclModule})
getBelongingSymbols {dcl_kind=STE_Imported STE_Type def_mod_index, dcl_index} dcl_modules
getBelongingSymbols (Declaration {decl_kind=STE_Imported STE_Type def_mod_index, decl_index}) dcl_modules
# ({td_rhs}, dcl_modules)
= dcl_modules![def_mod_index].dcl_common.com_type_defs.[dcl_index]
= dcl_modules![def_mod_index].dcl_common.com_type_defs.[decl_index]
= case td_rhs of
AlgType constructors
-> (BS_Constructors constructors, dcl_modules)
......@@ -251,9 +254,9 @@ getBelongingSymbols {dcl_kind=STE_Imported STE_Type def_mod_index, dcl_index} dc
-> (BS_Fields rt_fields, dcl_modules)
_
-> (BS_Nothing, dcl_modules)
getBelongingSymbols {dcl_kind=STE_Imported STE_Class def_mod_index, dcl_index} dcl_modules
getBelongingSymbols (Declaration {decl_kind=STE_Imported STE_Class def_mod_index, decl_index}) dcl_modules
# ({class_members}, dcl_modules)
= dcl_modules![def_mod_index].dcl_common.com_class_defs.[dcl_index]
= dcl_modules![def_mod_index].dcl_common.com_class_defs.[decl_index]
= (BS_Members class_members, dcl_modules)
getBelongingSymbols _ dcl_modules
= (BS_Nothing, dcl_modules)
......@@ -284,7 +287,7 @@ where
remove_declared_symbols_in_array symbol_index symbols symbol_table
| symbol_index<size symbols
#! (symbol,symbols) = symbols![symbol_index]
# {dcl_ident={id_info}}=symbol
# (Declaration {decl_ident={id_info}})=symbol
#! entry = sreadPtr id_info symbol_table
# {ste_kind,ste_def_level} = entry
| ste_kind == STE_Empty || ste_def_level > cModuleScope
......@@ -292,11 +295,13 @@ where
# symbol_table = symbol_table <:= (id_info, entry.ste_previous)
= case ste_kind of
STE_Field selector_id
#! dcl_index = symbols.[symbol_index].dcl_index
-> remove_declared_symbols_in_array (symbol_index+1) symbols (removeFieldFromSelectorDefinition selector_id NoIndex dcl_index symbol_table)
#! declaration = symbols.[symbol_index]
# (Declaration {decl_index}) = declaration
-> remove_declared_symbols_in_array (symbol_index+1) symbols (removeFieldFromSelectorDefinition selector_id NoIndex decl_index symbol_table)
STE_Imported (STE_Field selector_id) def_mod
#! dcl_index = symbols.[symbol_index].dcl_index
-> remove_declared_symbols_in_array (symbol_index+1) symbols (removeFieldFromSelectorDefinition selector_id def_mod dcl_index symbol_table)
#! declaration = symbols.[symbol_index]
# (Declaration {decl_index}) = declaration
-> remove_declared_symbols_in_array (symbol_index+1) symbols (removeFieldFromSelectorDefinition selector_id def_mod decl_index symbol_table)
_
-> remove_declared_symbols_in_array (symbol_index+1) symbols symbol_table
= symbol_table
......@@ -330,34 +335,36 @@ addDeclarationsOfDclModToSymbolTable ste_index locals imported cs
where
add_imports_in_array_to_symbol_table symbol_index symbols cs=:{cs_x}
| symbol_index<size symbols
#! ({dcl_ident,dcl_pos,dcl_kind},symbols) = symbols![symbol_index]
= case dcl_kind of
#! (Declaration {decl_ident,decl_pos,decl_kind},symbols) = symbols![symbol_index]
= case decl_kind of
STE_Imported def_kind def_mod
#! dcl_index= symbols.[symbol_index].dcl_index
(_, cs)
= addSymbol No dcl_ident dcl_pos dcl_kind
def_kind dcl_index def_mod cUndef cs
#! declaration = symbols.[symbol_index]
# (Declaration {decl_index}) = declaration
# (_, cs)
= addSymbol No decl_ident decl_pos decl_kind
def_kind decl_index def_mod cUndef cs
-> add_imports_in_array_to_symbol_table (symbol_index+1) symbols cs
STE_FunctionOrMacro _
#! dcl_index= symbols.[symbol_index].dcl_index
(_, cs)
= addImportedFunctionOrMacro No dcl_ident dcl_index cs
#! declaration = symbols.[symbol_index]
# (Declaration {decl_index}) = declaration
# (_, cs)
= addImportedFunctionOrMacro No decl_ident decl_index cs
-> add_imports_in_array_to_symbol_table (symbol_index+1) symbols cs
= cs
addLocalSymbolsForImportToSymbolTable :: !Int !{!Declaration} Int !*CheckState -> .CheckState;
addLocalSymbolsForImportToSymbolTable symbol_index symbols mod_index cs
| symbol_index<size symbols
# ({dcl_ident,dcl_pos,dcl_kind,dcl_index},symbols) = symbols![symbol_index]
= case dcl_kind of
# (Declaration {decl_ident,decl_pos,decl_kind,decl_index},symbols) = symbols![symbol_index]
= case decl_kind of
STE_FunctionOrMacro _
# (_, cs)
= addImportedFunctionOrMacro No dcl_ident dcl_index cs
= addImportedFunctionOrMacro No decl_ident decl_index cs
-> addLocalSymbolsForImportToSymbolTable (symbol_index+1) symbols mod_index cs
STE_Imported def_kind def_mod
# (_, cs)
= addSymbol No dcl_ident dcl_pos dcl_kind
def_kind dcl_index mod_index cUndef cs
= addSymbol No decl_ident decl_pos decl_kind
def_kind decl_index mod_index cUndef cs
-> addLocalSymbolsForImportToSymbolTable (symbol_index+1) symbols mod_index cs
= cs
......@@ -391,14 +398,14 @@ addFieldToSelectorDefinition {id_info} glob_field_index cs=:{cs_symbol_table}
-> { cs & cs_symbol_table = NewEntry cs.cs_symbol_table id_info (STE_Selector [glob_field_index]) NoIndex cModuleScope entry }
addSymbol :: !(Optional a) !Ident !Position !STE_Kind !STE_Kind !.Int !.Int !Int !*CheckState -> (!Bool, !.CheckState)
addSymbol yes_for_icl_module ident pos dcl_kind def_kind def_index def_mod importing_mod cs=:{cs_symbol_table}
addSymbol yes_for_icl_module ident pos decl_kind def_kind def_index def_mod importing_mod cs=:{cs_symbol_table}
# (entry, cs_symbol_table) = readPtr ident.id_info cs_symbol_table
= add_indirectly_imported_symbol yes_for_icl_module entry ident pos def_kind def_index def_mod
importing_mod { cs & cs_symbol_table = cs_symbol_table }
where
add_indirectly_imported_symbol _ {ste_kind = STE_Empty} {id_info} _ def_kind def_index def_mod _ cs=:{cs_symbol_table}
# (entry, cs_symbol_table) = readPtr id_info cs_symbol_table
cs = { cs & cs_symbol_table = NewEntry cs_symbol_table id_info dcl_kind def_index cModuleScope entry}
cs = { cs & cs_symbol_table = NewEntry cs_symbol_table id_info decl_kind def_index cModuleScope entry}
= case def_kind of
STE_Field selector_id
-> (True, addFieldToSelectorDefinition selector_id { glob_module = def_mod, glob_object = def_index } cs)
......@@ -421,26 +428,26 @@ addGlobalDefinitionsToSymbolTable :: ![Declaration] !*CheckState -> .CheckState;
addGlobalDefinitionsToSymbolTable decls cs
= foldSt add_global_definition decls cs
where
add_global_definition {dcl_ident=ident=:{id_info},dcl_pos,dcl_kind,dcl_index} cs=:{cs_symbol_table}
add_global_definition (Declaration {decl_ident=ident=:{id_info},decl_pos,decl_kind,decl_index}) cs=:{cs_symbol_table}
#! entry = sreadPtr id_info cs_symbol_table
| entry.ste_def_level < cGlobalScope
# cs = { cs & cs_symbol_table = NewEntry cs_symbol_table id_info dcl_kind dcl_index cGlobalScope entry }
= case dcl_kind of
# cs = { cs & cs_symbol_table = NewEntry cs_symbol_table id_info decl_kind decl_index cGlobalScope entry }
= case decl_kind of
STE_Field selector_id
-> addFieldToSelectorDefinition selector_id { glob_module = NoIndex, glob_object = dcl_index } cs
-> addFieldToSelectorDefinition selector_id { glob_module = NoIndex, glob_object = decl_index } cs
_
-> cs
= { cs & cs_error = checkErrorWithIdentPos (newPosition ident dcl_pos) " multiply defined" cs.cs_error}
= { cs & cs_error = checkErrorWithIdentPos (newPosition ident decl_pos) " multiply defined" cs.cs_error}
removeImportedSymbolsFromSymbolTable :: Declaration !*SymbolTable -> .SymbolTable
removeImportedSymbolsFromSymbolTable {dcl_ident=dcl_ident=:{id_info}, dcl_index} symbol_table
removeImportedSymbolsFromSymbolTable (Declaration {decl_ident=decl_ident=:{id_info}, decl_index}) symbol_table
# ({ste_kind,ste_def_level,ste_previous}, symbol_table)
= readPtr id_info symbol_table
symbol_table
= symbol_table <:= (id_info, ste_previous)
= case ste_kind of
STE_Imported (STE_Field selector_id) def_mod
-> removeFieldFromSelectorDefinition selector_id def_mod dcl_index symbol_table
-> removeFieldFromSelectorDefinition selector_id def_mod decl_index symbol_table
_
-> symbol_table
......@@ -463,12 +470,12 @@ removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*SymbolTable -> *Symbo
removeDeclarationsFromSymbolTable decls scope symbol_table
= foldSt (remove_declaration scope) decls symbol_table
where
remove_declaration scope decl=:{dcl_ident={id_info}, dcl_index} symbol_table
remove_declaration scope decl=:(Declaration {decl_ident={id_info}, decl_index}) symbol_table
# ({ste_kind,ste_previous}, symbol_table)
= readPtr id_info symbol_table
= case ste_kind of
STE_Field field_id
# symbol_table = removeFieldFromSelectorDefinition field_id NoIndex dcl_index symbol_table
# symbol_table = removeFieldFromSelectorDefinition field_id NoIndex decl_index symbol_table
| ste_previous.ste_def_level == scope
-> symbol_table <:= (id_info, ste_previous.ste_previous)
-> symbol_table <:= (id_info, ste_previous)
......@@ -522,12 +529,12 @@ newFreeVariable new_var []
local_declaration_for_import :: !u:Declaration .Index -> v:Declaration, [u <= v]
local_declaration_for_import decl=:{dcl_kind=STE_FunctionOrMacro _} module_n
local_declaration_for_import decl=:(Declaration {decl_kind=STE_FunctionOrMacro _}) module_n
= decl
local_declaration_for_import decl=:{dcl_kind=STE_Imported _ _} module_n
local_declaration_for_import decl=:(Declaration {decl_kind=STE_Imported _ _}) module_n
= abort "local_declaration_for_import"
local_declaration_for_import decl=:{dcl_kind} module_n
= {decl & dcl_kind = STE_Imported dcl_kind module_n}
local_declaration_for_import decl=:(Declaration declaration_record=:{decl_kind}) module_n
= Declaration {declaration_record & decl_kind = STE_Imported decl_kind module_n}
get_ident :: !ImportDeclaration -> Ident
......@@ -627,12 +634,66 @@ instance <<< DeclarationInfo
where
(<<<) file {di_decl, di_instances}
= file <<< di_decl <<< di_instances
import_ident :: Ident
import_ident =: { id_name = "import", id_info = nilPtr }
/*
ste_kind_to_string :: STE_Kind -> String
ste_kind_to_string ste_kind
= case ste_kind of
STE_FunctionOrMacro _
-> "STE_FunctionOrMacro"
STE_Type
-> "STE_Type"
STE_Constructor
-> "STE_Constructor"
STE_Selector _
-> "STE_Selector"
STE_Field _
-> "STE_Field"
STE_Class
-> "STE_Class"
STE_Member
-> "STE_Member"
STE_Instance _
-> "STE_Instance"
STE_Variable _
-> "STE_Variable"
STE_TypeVariable _
-> "STE_TypeVariable"
STE_TypeAttribute _
-> "STE_TypeAttribute"
STE_BoundTypeVariable _
-> "STE_BoundTypeVariable"
STE_Imported ste_kind2 _
-> "STE_Imported "+++ste_kind_to_string ste_kind2
STE_DclFunction
-> "STE_DclFunction"
STE_Module _
-> "STE_Module"
STE_ClosedModule
-> "STE_ClosedModule"
STE_Empty
-> "STE_Empty"
STE_DictType _
-> "STE_DictType"
STE_DictCons _
-> "STE_DictCons"
STE_DictField _
-> "STE_DictField"
STE_Called _
-> "STE_Called"
STE_ExplImpSymbol _
-> "STE_ExplImpSymbol"
STE_ExplImpComponentNrs _ _
-> "STE_ExplImpComponentNrs"
STE_BelongingSymbol _
-> "STE_BelongingSymbol"
*/
restoreHeap :: !Ident !*SymbolTable -> .SymbolTable
restoreHeap {id_info} cs_symbol_table
# ({ste_previous}, cs_symbol_table)
# ({ste_previous}, cs_symbol_table)
= readPtr id_info cs_symbol_table
= writePtr id_info ste_previous cs_symbol_table
= writePtr id_info ste_previous cs_symbol_table
implementation module checktypes
import StdEnv
import syntax, checksupport, check, typesupport, utilities, RWSDebug
import syntax, checksupport, check, typesupport, utilities //, RWSDebug
:: TypeSymbols =
......@@ -379,12 +379,14 @@ where
look_for_cycles mod_index {at_type} expst
= look_for_cycles mod_index at_type expst
import StdDebug
expandSynType :: !Index !Index !*ExpandState -> *ExpandState
expandSynType mod_index type_index expst=:{exp_type_defs}
# (type_def, exp_type_defs) = exp_type_defs![type_index]
expst = { expst & exp_type_defs = exp_type_defs }
= case type_def.td_rhs of
SynType type=:{at_type = TA {type_name,type_index={glob_object,glob_module}} types}
SynType type=:{at_type = TA {type_name,type_index={glob_object,glob_module}} types}
# ({td_args,td_attribute,td_rhs}, _, exp_type_defs, exp_modules) = getTypeDef glob_object glob_module mod_index expst.exp_type_defs expst.exp_modules
expst = { expst & exp_type_defs = exp_type_defs, exp_modules = exp_modules }
-> case td_rhs of
......@@ -429,6 +431,26 @@ expand_syn_types module_index type_index nr_of_types expst
# expst = expandSynType module_index type_index expst
= expand_syn_types module_index (inc type_index) nr_of_types expst
= expand_syn_types module_index (inc type_index) nr_of_types expst
/*
Tracea_tn a
# s=size a
# f=stderr
# r=t 0 f
with
t i f
| i<s && file_to_true (stderr <<< i <<< '\n' <<< a.[i] <<< '\n')
= t (i+1) f
= True
= r
file_to_true :: !File -> Bool;
file_to_true file = code {
.inline file_to_true
pop_b 2
pushB TRUE
.end
}
*/
expandSynonymTypes :: !.Index !*{#CheckedTypeDef} !*{#.DclModule} !*TypeHeaps !*ErrorAdmin
-> (!.{#CheckedTypeDef},!.{#DclModule},!.TypeHeaps,!.ErrorAdmin)
......
......@@ -85,6 +85,12 @@ compareDefImp :: !{#Int} !{!FunctionBody} !Int !{#CheckedTypeDef} !DclModule !*I
-> (!.IclModule,!.Heaps,!.ErrorAdmin)
compareDefImp size_uncopied_icl_defs untransformed main_dcl_module_n icl_com_type_defs main_dcl_module
icl_module heaps error_admin
// | print_function_body_array untransformed
// && print_function_body_array icl_module.icl_functions
// icl definitions with indices >= size_uncopied_icl_defs.[def_type] don't have to be compared,
// because they are copies of definitions that appear exclusively in the dcl module
= case main_dcl_module.dcl_conversions of
......@@ -106,7 +112,7 @@ compareDefImp size_uncopied_icl_defs untransformed main_dcl_module_n icl_com_typ
(_, tc_state, error_admin)
= compareWithConversions
size_uncopied_icl_defs.[cTypeDefs] conversion_table.[cTypeDefs]
dcl_common.com_type_defs icl_com_type_defs tc_state error_admin
dcl_common.com_unexpanded_type_defs icl_com_type_defs tc_state error_admin
(icl_com_cons_defs, tc_state, error_admin)
= compareWithConversions
size_uncopied_icl_defs.[cConstructorDefs] conversion_table.[cConstructorDefs]
......@@ -867,6 +873,7 @@ continuation_for_possibly_twice_defined_macros dcl_app_symb dcl_index icl_app_sy
= ec_state
= give_error icl_app_symb.symb_name ec_state
where
names_are_compatible :: Int Int {#FunDef} -> Bool;
names_are_compatible dcl_index icl_index icl_functions
# dcl_function = icl_functions.[dcl_index]
icl_function = icl_functions.[icl_index]
......@@ -930,3 +937,23 @@ do_nothing ec_state
give_error s ec_state
= { ec_state & ec_error_admin = checkError s error_message ec_state.ec_error_admin }
/*
print_function_body_array function_bodies
= print_function_bodies 0
where
print_function_bodies i
| i<size function_bodies
= Trace_tn i && Trace_tn function_bodies.[i] && print_function_bodies (i+1)
= True;
Trace_tn d
= file_to_true (stderr <<< d <<< '\n')
file_to_true :: !File -> Bool;
file_to_true file = code {
.inline file_to_true
pop_b 2
pushB TRUE
.end
};
*/
......@@ -1124,7 +1124,7 @@ weightedRefCountOfCase dcl_functions common_defs depth this_case=:{case_expr, ca
= weightedRefCountInPatternExpr rc_main_dcl_module_n dcl_functions common_defs depth expr info
weighted_ref_count_in_default dcl_functions common_defs depth No info
= ([], info)
weighted_ref_count_in_case_patterns dcl_functions common_defs depth (AlgebraicPatterns type patterns) collected_imports var_heap expr_heap
= mapSt (weighted_ref_count_in_algebraic_pattern dcl_functions common_defs depth) patterns ([], collected_imports, var_heap, expr_heap)
where
......@@ -1411,7 +1411,7 @@ my_zip [x:xs][y:ys] = [(x,y) : my_zip xs ys]
instance distributeLets Case
where
distributeLets depth kees=:{case_info_ptr,case_guards,case_default,case_expr} dl_info=:{di_var_heap, di_expr_heap}
distributeLets depth kees=:{case_info_ptr,case_guards,case_default,case_expr} dl_info=:{di_var_heap, di_expr_heap}
# (EI_CaseTypeAndRefCounts case_type { rcc_all_variables = tot_ref_counts , rcc_default_variables = ref_counts_in_default, rcc_pattern_variables = ref_counts_in_patterns }, di_expr_heap) = readPtr case_info_ptr di_expr_heap
// di_expr_heap = di_expr_heap <:= (case_info_ptr, EI_CaseType case_type)
new_depth = inc depth
......@@ -1567,10 +1567,15 @@ where
instance <<< (Ptr a)
where
(<<<) file ptr = file <<< ptrToInt ptr
/*
instance <<< BoundVar
where
(<<<) file {var_name,var_info_ptr} = file <<< var_name <<< '[' <<< var_info_ptr <<< ']'
instance <<< FunctionBody
where
(<<<) file (TransformedBody {tb_rhs}) = file <<< tb_rhs
*/
instance <<< CountedVariable
where
......
......@@ -10,7 +10,7 @@ import StdEnv
, fs_error :: !.ErrorAdmin
}
import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef, RWSDebug, cheat
import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef, cheat//, RWSDebug
cUndef :== (-1)
implies a b :== not a || b
......@@ -25,7 +25,6 @@ implies a b :== not a || b
, si_implicit :: ![(Index, Position)] // module indices
}
markExplImpSymbols :: !Int !*(!*{!*{!u:ExplImpInfo}}, !*SymbolTable)
-> (!.[Ident],!(!{!{!u:ExplImpInfo}},!.SymbolTable))
markExplImpSymbols component_nr (expl_imp_info, cs_symbol_table)
......@@ -61,8 +60,6 @@ markExplImpSymbols component_nr (expl_imp_info, cs_symbol_table)
(eii_ident, eii)
= get_eei_ident eii
= (eii_ident, { expl_imp_info & [component_nr, i] = eii })
updateExplImpForMarkedSymbol :: !Index !Declaration !SymbolTableEntry !u:{#DclModule} !{!{!*ExplImpInfo}} !*SymbolTable
-> (!u:{#DclModule}, !{!{!.ExplImpInfo}}, !.SymbolTable)
......@@ -73,7 +70,6 @@ updateExplImpForMarkedSymbol mod_index decl {ste_kind=STE_ExplImpComponentNrs co
updateExplImpForMarkedSymbol _ _ entry dcl_modules expl_imp_infos cs_symbol_table
= (dcl_modules, expl_imp_infos, cs_symbol_table)
addExplImpInfo :: !Index Declaration ![Declaration] !ComponentNrAndIndex !(!u:{#DclModule}, !{!{!*ExplImpInfo}}, !v:SymbolTable)
-> (!u:{#DclModule}, !{!{!.ExplImpInfo}}, !v:SymbolTable)
addExplImpInfo mod_index decl instances { cai_component_nr, cai_index } (dcl_modules, expl_imp_infos, cs_symbol_table)
......@@ -108,12 +104,11 @@ addExplImpInfo mod_index decl instances { cai_component_nr, cai_index } (dcl_mod
, cs_symbol_table
)
optStoreInstanceWithClassSymbol :: Declaration !Ident !*SymbolTable -> .SymbolTable
optStoreInstanceWithClassSymbol decl class_ident cs_symbol_table
// this function is only for old syntax
| switch_import_syntax False True
= cs_symbol_table
= cs_symbol_table
# (class_ste, cs_symbol_table)
= readPtr class_ident.id_info cs_symbol_table
= case class_ste.ste_kind of
......@@ -124,8 +119,6 @@ optStoreInstanceWithClassSymbol decl class_ident cs_symbol_table
_
-> cs_symbol_table
foldlBelongingSymbols f bs st
:== case bs of
BS_Constructors constructors
......@@ -136,6 +129,18 @@ foldlBelongingSymbols f bs st
-> foldlArraySt (\{ds_ident} st -> f ds_ident st) members st
BS_Nothing
-> st
/*
imp_decl_to_string (ID_Function {ii_ident={id_name}}) = "ID_Function "+++toString id_name
imp_decl_to_string (ID_Class {ii_ident={id_name}} _) = "ID_Class "+++toString id_name
imp_decl_to_string (ID_Type {ii_ident={id_name}} _) = "ID_Type "+++toString id_name
imp_decl_to_string (ID_Record {ii_ident={id_name}} _) = "ID_Record "+++toString id_name
imp_decl_to_string (ID_Instance {ii_ident={id_name}} _ _ ) = "ID_Instance "+++toString id_name
imp_decl_to_string (ID_OldSyntax idents) = "ID_OldSyntax "+++idents_to_string idents
where
idents_to_string [] = ""
idents_to_string [{id_name}] = toString id_name
idents_to_string [{id_name}:l] = toString id_name+++","+++idents_to_string l
*/
solveExplicitImports :: !(IntKeyHashtable [(Int,Position,[ImportNrAndIdents])]) !{#Int} !Index
!*(!v:{#DclModule},!*{#Int},!{!*ExplImpInfo},!*CheckState)
......@@ -238,30 +243,30 @@ solveExplicitImports expl_imp_indices_ikh modules_in_component_set importing_mod
= abort "sanity check nr 2765 failed in module check"
= eii_declaring_modules
get_nth_belonging_decl position belong_nr decl dcl_modules
# (STE_Imported _ def_mod_index) = decl.dcl_kind
get_nth_belonging_decl position belong_nr decl=:(Declaration {decl_kind}) dcl_modules
# (STE_Imported _ def_mod_index) = decl_kind
(belongin_symbols, dcl_modules)
= getBelongingSymbols decl dcl_modules
= case belongin_symbols of
BS_Constructors constructors
# {ds_ident, ds_index} = constructors!!belong_nr
-> ({ dcl_ident = ds_ident, dcl_pos = position,
dcl_kind = STE_Imported STE_Constructor def_mod_index,
dcl_index = ds_index }, dcl_modules)
-> (Declaration { decl_ident = ds_ident, decl_pos = position,
decl_kind = STE_Imported STE_Constructor def_mod_index,