Commit e4ea68cd authored by Ronny Wichers Schreur's avatar Ronny Wichers Schreur 🏢
Browse files

major rewrite dynamics

parent e5c806d3
...@@ -916,7 +916,7 @@ convertSelector moduleIndex selectorDefs is_strict {fs_index} ...@@ -916,7 +916,7 @@ convertSelector moduleIndex selectorDefs is_strict {fs_index}
declareDynamicTemp :: PredefinedSymbols -> BackEnder declareDynamicTemp :: PredefinedSymbols -> BackEnder
declareDynamicTemp predefs declareDynamicTemp predefs
= appBackEnd (BEDeclareDynamicTypeSymbol predefs.[PD_StdDynamic].pds_def predefs.[PD_DynamicTemp].pds_def) = appBackEnd (BEDeclareDynamicTypeSymbol predefs.[PD_StdDynamic].pds_def predefs.[PD_Dyn_DynamicTemp].pds_def)
predefineSymbols :: DclModule PredefinedSymbols -> BackEnder predefineSymbols :: DclModule PredefinedSymbols -> BackEnder
predefineSymbols {dcl_common} predefs predefineSymbols {dcl_common} predefs
...@@ -1693,7 +1693,8 @@ convertRootExpr aliasDummyId (Case kees=:{case_expr, case_guards}) main_dcl_modu ...@@ -1693,7 +1693,8 @@ convertRootExpr aliasDummyId (Case kees=:{case_expr, case_guards}) main_dcl_modu
Yes ident Yes ident
-> DefaultCaseFail ident -> DefaultCaseFail ident
_ _
-> abort "backendconvert:defaultCase, case without id" -> DefaultCaseFail {id_name="kees_be", id_info=nilPtr}
// -> abort "backendconvert:defaultCase, case without id"
// otherwise // otherwise
= DefaultCaseNone = DefaultCaseNone
convertRootExpr _ (FailExpr fail_ident) _ convertRootExpr _ (FailExpr fail_ident) _
...@@ -1826,6 +1827,8 @@ where ...@@ -1826,6 +1827,8 @@ where
= beFunctionSymbol glob_object glob_module = beFunctionSymbol glob_object glob_module
convertSymbol {symb_kind=SK_LocalMacroFunction glob_object} convertSymbol {symb_kind=SK_LocalMacroFunction glob_object}
= beFunctionSymbol glob_object main_dcl_module_n = beFunctionSymbol glob_object main_dcl_module_n
convertSymbol {symb_kind=SK_GeneratedCaseFunction _ index}
= beFunctionSymbol index main_dcl_module_n
convertSymbol {symb_kind=SK_GeneratedFunction _ index} convertSymbol {symb_kind=SK_GeneratedFunction _ index}
= beFunctionSymbol index main_dcl_module_n = beFunctionSymbol index main_dcl_module_n
convertSymbol {symb_kind=SK_GeneratedCaseFunction _ index} convertSymbol {symb_kind=SK_GeneratedCaseFunction _ index}
......
...@@ -2453,7 +2453,8 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo ...@@ -2453,7 +2453,8 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo
(x_main_dcl_module,cs) = cs!cs_x.x_main_dcl_module_n (x_main_dcl_module,cs) = cs!cs_x.x_main_dcl_module_n
cs = cs cs = cs
<=< adjustPredefSymbol PD_ModuleConsSymbol x_main_dcl_module STE_Constructor <=< adjustPredefSymbol PD_ModuleConsSymbol x_main_dcl_module STE_Constructor
(dcl_modules, icl_functions,macro_defs,hp_expression_heap, cs) (dcl_modules, icl_functions,macro_defs,hp_expression_heap, cs)
= checkExplicitImportCompleteness imports.si_explicit dcl_modules icl_functions macro_defs heaps.hp_expression_heap cs = checkExplicitImportCompleteness imports.si_explicit dcl_modules icl_functions macro_defs heaps.hp_expression_heap cs
...@@ -3387,19 +3388,19 @@ where ...@@ -3387,19 +3388,19 @@ where
# (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdDynamic] # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdDynamic]
| pre_mod.pds_def == mod_index | pre_mod.pds_def == mod_index
= (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols} = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols}
<=< adjustPredefSymbol PD_TypeObjectType mod_index STE_Type <=< adjustPredefSymbol PD_Dyn_DynamicTemp mod_index STE_Type
<=< adjustPredefSymbol PD_TypeConsSymbol mod_index STE_Constructor <=< adjustPredefSymbol PD_Dyn_Type mod_index STE_Type
<=< adjustPredefSymbol PD_PV_Placeholder mod_index STE_Constructor <=< adjustPredefSymbol PD_Dyn_TypeScheme mod_index STE_Constructor
<=< adjustPredefSymbol PD_UPV_Placeholder mod_index STE_Constructor <=< adjustPredefSymbol PD_Dyn_TypeApp mod_index STE_Constructor
<=< adjustPredefSymbol PD_UV_Placeholder mod_index STE_Constructor <=< adjustPredefSymbol PD_Dyn_TypeVar mod_index STE_Constructor
<=< adjustPredefSymbol PD_unify mod_index STE_DclFunction <=< adjustPredefSymbol PD_Dyn_TypePatternVar mod_index STE_Constructor
<=< adjustPredefSymbol PD_coerce mod_index STE_DclFunction <=< adjustPredefSymbol PD_Dyn_ModuleID mod_index STE_Constructor
<=< adjustPredefSymbol PD_undo_indirections mod_index STE_DclFunction <=< adjustPredefSymbol PD_Dyn_Unifier mod_index STE_Type
<=< adjustPredefSymbol PD_DynamicTemp mod_index STE_Type <=< adjustPredefSymbol PD_Dyn_unify mod_index STE_DclFunction
<=< adjustPredefSymbol PD_DynamicType mod_index (STE_Field unused) <=< adjustPredefSymbol PD_Dyn_initial_unifier mod_index STE_DclFunction
<=< adjustPredefSymbol PD_DynamicValue mod_index (STE_Field unused) <=< adjustPredefSymbol PD_Dyn_normalise mod_index STE_DclFunction
<=< adjustPredefSymbol PD_TypeID mod_index STE_Type <=< adjustPredefSymbol PD_Dyn_bind_global_type_pattern_var mod_index STE_DclFunction)
<=< adjustPredefSymbol PD_ModuleID mod_index STE_Constructor)
# (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdGeneric] # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdGeneric]
# type_bimap = predefined_idents.[PD_TypeBimap] # type_bimap = predefined_idents.[PD_TypeBimap]
| pre_mod.pds_def == mod_index | pre_mod.pds_def == mod_index
......
...@@ -7,7 +7,7 @@ switch_import_syntax one_point_three two_point_zero :== two_point_zero ...@@ -7,7 +7,7 @@ switch_import_syntax one_point_three two_point_zero :== two_point_zero
SwitchPreprocessor preprocessor no_preprocessor :== preprocessor SwitchPreprocessor preprocessor no_preprocessor :== preprocessor
SwitchGenerics on off :== off SwitchGenerics on off :== on
SwitchGenericInfo on off :== on SwitchGenericInfo on off :== on
// MV... // MV...
...@@ -16,5 +16,5 @@ SwitchGenericInfo on off :== on ...@@ -16,5 +16,5 @@ SwitchGenericInfo on off :== on
USE_DummyModuleName yes no :== yes USE_DummyModuleName yes no :== yes
switch_dynamics on off :== off; // to turn dynamics on or off switch_dynamics on off :== on; // to turn dynamics on or off
// ...MV // ...MV
...@@ -7,7 +7,7 @@ switch_import_syntax one_point_three two_point_zero :== two_point_zero ...@@ -7,7 +7,7 @@ switch_import_syntax one_point_three two_point_zero :== two_point_zero
SwitchPreprocessor preprocessor no_preprocessor :== preprocessor SwitchPreprocessor preprocessor no_preprocessor :== preprocessor
SwitchGenerics on off :== off SwitchGenerics on off :== on
SwitchGenericInfo on off :== on SwitchGenericInfo on off :== on
// MV... // MV...
...@@ -16,5 +16,5 @@ SwitchGenericInfo on off :== on ...@@ -16,5 +16,5 @@ SwitchGenericInfo on off :== on
USE_DummyModuleName yes no :== yes USE_DummyModuleName yes no :== yes
switch_dynamics on off :== off; // to turn dynamics on or off switch_dynamics on off :== on; // to turn dynamics on or off
// ...MV // ...MV
...@@ -3,16 +3,8 @@ ...@@ -3,16 +3,8 @@
*/ */
definition module convertDynamics definition module convertDynamics
import syntax, transform, convertcases import syntax, transform
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !Int !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap (Optional *File) {# DclModule} !IclModule /* TD */ [String] convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !Int !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap (Optional *File) {# DclModule} !IclModule /* TD */ [String]
-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap, Optional *File) -> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap, Optional *File)
/*
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !*{! Group} !*{#FunDef} !*PredefinedSymbols
!*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps !*ExpressionHeap
-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
*/
get_module_id_app :: !*PredefinedSymbols -> (App,Expression,!*PredefinedSymbols)
This diff is collapsed.
...@@ -1093,8 +1093,9 @@ where ...@@ -1093,8 +1093,9 @@ where
| isEmpty fi_dynamics | isEmpty fi_dynamics
= update_dynamics funs type_pattern_vars fun_defs fun_env symbol_heap type_code_info var_heap error predef_symbols = update_dynamics funs type_pattern_vars fun_defs fun_env symbol_heap type_code_info var_heap error predef_symbols
// MV ... // MV ...
# (_,module_id_app,predef_symbols) // # (_,module_id_app,predef_symbols)
= get_module_id_app predef_symbols // = get_module_id_app predef_symbols
# module_id_app = undef
// ... MV // ... MV
# (type_code_info, symbol_heap, type_pattern_vars, var_heap, error) # (type_code_info, symbol_heap, type_pattern_vars, var_heap, error)
= convertDynamicTypes fi_dynamics (type_code_info, symbol_heap, type_pattern_vars, var_heap, error) = convertDynamicTypes fi_dynamics (type_code_info, symbol_heap, type_pattern_vars, var_heap, error)
...@@ -1107,6 +1108,7 @@ where ...@@ -1107,6 +1108,7 @@ where
= updateExpression fi_group_index tb.tb_rhs = updateExpression fi_group_index tb.tb_rhs
{ ui_instance_calls = [], ui_symbol_heap = symbol_heap, ui_fun_defs = fun_defs, ui_local_vars = fi_local_vars, { ui_instance_calls = [], ui_symbol_heap = symbol_heap, ui_fun_defs = fun_defs, ui_local_vars = fi_local_vars,
ui_fun_env = fun_env, ui_var_heap = var_heap, ui_error = error, ui_fun_env = fun_env, ui_var_heap = var_heap, ui_error = error,
ui_has_type_codes = False,
// MV ... // MV ...
ui_x = {x_type_code_info=type_code_info, x_predef_symbols=predef_symbols,x_main_dcl_module_n=main_dcl_module_n,x_internal_type_id = module_id_app,x_module_id = No}} ui_x = {x_type_code_info=type_code_info, x_predef_symbols=predef_symbols,x_main_dcl_module_n=main_dcl_module_n,x_internal_type_id = module_id_app,x_module_id = No}}
// ... MV // ... MV
...@@ -1149,8 +1151,9 @@ where ...@@ -1149,8 +1151,9 @@ where
remove_overloaded_function type_pattern_vars fun_index (ok, fun_defs, fun_env, symbol_heap, type_code_info, var_heap, error, predef_symbols) remove_overloaded_function type_pattern_vars fun_index (ok, fun_defs, fun_env, symbol_heap, type_code_info, var_heap, error, predef_symbols)
| ok | ok
// MV ... // MV ...
# (_,module_id_app,predef_symbols) // # (_,module_id_app,predef_symbols)
= get_module_id_app predef_symbols // = get_module_id_app predef_symbols
# module_id_app = undef
// ... MV // ... MV
# (fun_def, fun_defs) = fun_defs![fun_index] # (fun_def, fun_defs) = fun_defs![fun_index]
(CheckedType st=:{st_context}, fun_env) = fun_env![fun_index] (CheckedType st=:{st_context}, fun_env) = fun_env![fun_index]
...@@ -1165,18 +1168,27 @@ where ...@@ -1165,18 +1168,27 @@ where
= updateExpression fun_info.fi_group_index tb_rhs { ui_instance_calls = [], ui_local_vars = fun_info.fi_local_vars, ui_symbol_heap = symbol_heap, = updateExpression fun_info.fi_group_index tb_rhs { ui_instance_calls = [], ui_local_vars = fun_info.fi_local_vars, ui_symbol_heap = symbol_heap,
ui_var_heap = var_heap, ui_fun_defs = fun_defs, ui_fun_env = fun_env, ui_error = error, ui_var_heap = var_heap, ui_fun_defs = fun_defs, ui_fun_env = fun_env, ui_error = error,
// MV ... // MV ...
ui_has_type_codes = False,
ui_x = {x_type_code_info=type_code_info, x_predef_symbols=predef_symbols,x_main_dcl_module_n=main_dcl_module_n,x_internal_type_id = module_id_app,x_module_id = No}} ui_x = {x_type_code_info=type_code_info, x_predef_symbols=predef_symbols,x_main_dcl_module_n=main_dcl_module_n,x_internal_type_id = module_id_app,x_module_id = No}}
# (tb_rhs, {ui_instance_calls, ui_local_vars, ui_symbol_heap, ui_var_heap, ui_fun_defs, ui_fun_env, ui_error, ui_x = {x_type_code_info = type_code_info, x_predef_symbols = predef_symbols}}) # (tb_rhs, {ui_instance_calls, ui_local_vars, ui_symbol_heap, ui_var_heap, ui_fun_defs, ui_fun_env, ui_has_type_codes, ui_error, ui_x = {x_type_code_info = type_code_info, x_predef_symbols = predef_symbols}})
= build_type_identification tb_rhs ui = build_type_identification tb_rhs ui
# #
// ... MV // ... MV
(tb_args, var_heap) = foldSt retrieve_class_argument rev_variables (tb_args, ui_var_heap) (tb_args, var_heap) = foldSt retrieve_class_argument rev_variables (tb_args, ui_var_heap)
fun_info = mark_type_codes ui_has_type_codes fun_info
fun_def = { fun_def & fun_body = TransformedBody {tb_args = tb_args, tb_rhs = tb_rhs}, fun_arity = length tb_args, fun_def = { fun_def & fun_body = TransformedBody {tb_args = tb_args, tb_rhs = tb_rhs}, fun_arity = length tb_args,
fun_info = { fun_info & fi_calls = fun_info.fi_calls ++ ui_instance_calls, fi_local_vars = ui_local_vars } } fun_info = { fun_info & fi_calls = fun_info.fi_calls ++ ui_instance_calls, fi_local_vars = ui_local_vars } }
#! ok = ui_error.ea_ok #! ok = ui_error.ea_ok
= (ok, { ui_fun_defs & [fun_index] = fun_def }, ui_fun_env, ui_symbol_heap, type_code_info, var_heap, ui_error, predef_symbols) = (ok, { ui_fun_defs & [fun_index] = fun_def }, ui_fun_env, ui_symbol_heap, type_code_info, var_heap, ui_error, predef_symbols)
= (False, fun_defs, fun_env, symbol_heap, type_code_info, var_heap, error, predef_symbols) = (False, fun_defs, fun_env, symbol_heap, type_code_info, var_heap, error, predef_symbols)
where
// this is a ugly way to mark this function for conversion in convertDynamics
// FIXME: find a better way to mark the function
mark_type_codes True info=:{fi_dynamics=[]}
= {info & fi_dynamics = [nilPtr]}
mark_type_codes _ info
= info
determine_class_argument {tc_class, tc_var} (variables, var_heap) determine_class_argument {tc_class, tc_var} (variables, var_heap)
# (var_info, var_heap) = readPtr tc_var var_heap # (var_info, var_heap) = readPtr tc_var var_heap
...@@ -1375,6 +1387,7 @@ where ...@@ -1375,6 +1387,7 @@ where
, ui_fun_defs :: !.{# FunDef} , ui_fun_defs :: !.{# FunDef}
, ui_fun_env :: !.{! FunctionType} , ui_fun_env :: !.{! FunctionType}
, ui_error :: !.ErrorAdmin , ui_error :: !.ErrorAdmin
, ui_has_type_codes :: !Bool
, ui_x :: !.UpdateInfoX , ui_x :: !.UpdateInfoX
} }
...@@ -1533,9 +1546,7 @@ where ...@@ -1533,9 +1546,7 @@ where
# (dyn_expr, ui) = updateExpression group_index dyn_expr ui # (dyn_expr, ui) = updateExpression group_index dyn_expr ui
(EI_TypeOfDynamic uni_vars type_code, ui_symbol_heap) = readPtr dyn_info_ptr ui.ui_symbol_heap (EI_TypeOfDynamic uni_vars type_code, ui_symbol_heap) = readPtr dyn_info_ptr ui.ui_symbol_heap
ui = { ui & ui_symbol_heap = ui_symbol_heap } ui = { ui & ui_symbol_heap = ui_symbol_heap }
| isEmpty uni_vars = (DynamicExpr { dyn & dyn_expr = dyn_expr, dyn_type_code = type_code }, ui)
= (DynamicExpr { dyn & dyn_expr = dyn_expr, dyn_type_code = type_code }, ui)
= (DynamicExpr { dyn & dyn_expr = dyn_expr, dyn_type_code = TCE_UniType uni_vars type_code }, ui)
updateExpression group_index (MatchExpr cons_symbol expr) ui updateExpression group_index (MatchExpr cons_symbol expr) ui
# (expr, ui) = updateExpression group_index expr ui # (expr, ui) = updateExpression group_index expr ui
= (MatchExpr cons_symbol expr, ui) = (MatchExpr cons_symbol expr, ui)
...@@ -1645,137 +1656,8 @@ where ...@@ -1645,137 +1656,8 @@ where
adjustClassExpression symb_name (Selection opt_type expr selectors) ui adjustClassExpression symb_name (Selection opt_type expr selectors) ui
# (expr, ui) = adjustClassExpression symb_name expr ui # (expr, ui) = adjustClassExpression symb_name expr ui
= (Selection opt_type expr selectors, ui) = (Selection opt_type expr selectors, ui)
adjustClassExpression symb_name (TypeCodeExpression type_code_expression) ui adjustClassExpression symb_name tce=:(TypeCodeExpression _) ui
= convertTypecode type_code_expression ui = (tce, {ui & ui_has_type_codes = True})
where
convertTypecode TCE_Empty ui
= (EE, ui)
convertTypecode (TCE_Var var_info_ptr) ui
= (Var {var_name = a_ij_var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr}, ui)
convertTypecode (TCE_TypeTerm var_info_ptr) ui=:{ui_var_heap,ui_error}
# (var_info_ptr, (ui_var_heap,ui_error)) = getTCDictionary symb_name var_info_ptr (ui_var_heap, ui_error)
= (Var {var_name = v_tc_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr}, { ui & ui_var_heap = ui_var_heap, ui_error = ui_error})
// MV ...
convertTypecode (TCE_Constructor index typecode_exprs) ui=:{ui_x={x_internal_type_id,x_type_code_info={tci_type_constructors_in_patterns} }}
# ui
= { ui & ui_x.x_type_code_info.tci_type_constructors_in_patterns = [index:tci_type_constructors_in_patterns] }
# (typecons_symb,ui) = getSymbol PD_TypeConsSymbol SK_Constructor ui
(constructor,ui) = get_constructor index ui
(typecode_exprs, ui) = convertTypecodes typecode_exprs ui
# (ui_internal_type_id,ui)
= get_module_id ui
= (App {app_symb = typecons_symb,
app_args = USE_DummyModuleName [constructor , ui_internal_type_id, typecode_exprs] [constructor , typecode_exprs] ,
app_info_ptr = nilPtr}, ui)
where
get_module_id ui=:{ui_x={x_module_id=Yes {lb_dst}}}
= (Var (freeVarToVar lb_dst),ui)
get_module_id ui
# (dst=:{var_info_ptr},ui)
= newVariable "module_id" VI_Empty ui
# dst_fv
= varToFreeVar dst 1
# let_bind
= { lb_src = x_internal_type_id
, lb_dst = dst_fv
, lb_position = NoPos
}
# ui
= { ui &
ui_local_vars = [ dst_fv : ui.ui_local_vars ]
, ui_x = { ui.ui_x & x_module_id = Yes let_bind}
}
= (Var dst,ui)
freeVarToVar :: FreeVar -> BoundVar
freeVarToVar {fv_name, fv_info_ptr}
= { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr}
newVariable :: String !VarInfo !*UpdateInfo -> *(!BoundVar,!*UpdateInfo)
newVariable var_name var_info ui=:{ui_var_heap}
# (var_info_ptr, ui_var_heap) = newPtr var_info ui_var_heap
= ( { var_name = {id_name = var_name, id_info = nilPtr}, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr},
{ ui & ui_var_heap = ui_var_heap })
// ... MV
convertTypecode (TCE_Selector selections var_info_ptr) ui
= (Selection NormalSelector (Var { var_name = a_ij_var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr }) selections, ui)
convertTypecode (TCE_UniType uni_vars type_code) ui
# (let_binds, ui) = createUniversalVariables uni_vars ui
(let_expr, ui) = convertTypecode type_code ui
(let_info_ptr,ui) = let_ptr (length let_binds) ui
= ( Let { let_strict_binds = []
, let_lazy_binds = let_binds
, let_expr = let_expr
, let_info_ptr = let_info_ptr
, let_expr_position = NoPos
}, ui)
convertTypecodes [] ui
# (nil_symb, ui) = getSymbol PD_NilSymbol SK_Constructor ui
= (App { app_symb = nil_symb,
app_args = [],
app_info_ptr = nilPtr}, ui)
convertTypecodes [typecode_expr : typecode_exprs] ui
# (cons_symb, ui) = getSymbol PD_ConsSymbol SK_Constructor ui
(expr, ui) = convertTypecode typecode_expr ui
(exprs, ui) = convertTypecodes typecode_exprs ui
= (App { app_symb = cons_symb,
app_args = [expr , exprs],
app_info_ptr = nilPtr}, ui)
createUniversalVariables var_info_ptrs ui
= createVariables2 True var_info_ptrs ui
createVariables2 generate_universal_placeholders var_info_ptrs ui
= mapSt create_variable var_info_ptrs ui
where
create_variable var_info_ptr ui
# (placeholder_symb, ui)
= getSymbol PD_UPV_Placeholder SK_Constructor ui
cyclic_var = {var_name = v_tc_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr}
cyclic_fv = varToFreeVar cyclic_var 1
= ({ lb_src = App { app_symb = placeholder_symb,
app_args = [Var cyclic_var, Var cyclic_var],
app_info_ptr = nilPtr },
lb_dst = varToFreeVar cyclic_var 1,
lb_position = NoPos
},
{ ui & ui_local_vars = [cyclic_fv : ui.ui_local_vars]})
getSymbol :: !Int !((Global Int) -> SymbKind) !*UpdateInfo -> (SymbIdent,*UpdateInfo)
getSymbol index symb_kind ui=:{ui_x}
# ({pds_module, pds_def}, ui_x) = ui_x!x_predef_symbols.[index]
# pds_ident = predefined_idents.[index]
symbol = { symb_name = pds_ident, symb_kind = symb_kind { glob_module = pds_module, glob_object = pds_def} }
= (symbol, { ui & ui_x = ui_x})
get_constructor :: !Int !*UpdateInfo -> (!Expression,!*UpdateInfo)
get_constructor index ui=:{ui_x = {x_type_code_info={tci_instances}}}
/*
** MV
** Inefficiency. The correct gtci_type referred to by index has to be selected from the list of
** instances (tci_instances). A rather inefficient linear search is used to look up the type. It
** is a temporary solution.
*/
# tci_instance
= filter (\{gtci_index} -> gtci_index == index) tci_instances // {createArray ? GTT_Function & [gtci_index] = gtci_type \\ {gtci_index, gtci_type} <- tci_instances}
| isEmpty tci_instance
= abort "get_constructor (overloading.icl): internal error"
# tci_instance
= (hd tci_instance).gtci_type // tci_instances.[index]
# cons_expr
= BasicExpr (BVS ("\"" +++ toString tci_instance +++ "\""))
= (cons_expr,ui)
a_ij_var_name = { id_name = "a_ij", id_info = nilPtr }
v_tc_name = { id_name = "overloadingvTC", id_info = nilPtr }
varToFreeVar :: BoundVar Int -> FreeVar
varToFreeVar {var_name, var_info_ptr} count
= {fv_def_level = NotALevel, fv_name = var_name, fv_info_ptr = var_info_ptr, fv_count = count}
adjustClassExpression symb_name (Let this_let=:{let_strict_binds, let_lazy_binds, let_expr }) ui adjustClassExpression symb_name (Let this_let=:{let_strict_binds, let_lazy_binds, let_expr }) ui
# (let_strict_binds, ui) = adjust_let_binds symb_name let_strict_binds ui # (let_strict_binds, ui) = adjust_let_binds symb_name let_strict_binds ui
(let_lazy_binds, ui) = adjust_let_binds symb_name let_lazy_binds ui (let_lazy_binds, ui) = adjust_let_binds symb_name let_lazy_binds ui
......
...@@ -69,9 +69,10 @@ PD_TypeVar_a31 :== 119 ...@@ -69,9 +69,10 @@ PD_TypeVar_a31 :== 119
/* Dynamics */ /* Dynamics */
PD_TypeCodeMember :== 120 PD_TypeCodeMember :== 120
PD_DynamicTemp :== 121 PD_TypeCodeClass :== 121
PD_DynamicValue :== 122 PD_Dyn_bind_global_type_pattern_var
PD_DynamicType :== 123 :== 122
PD_Dyn_ModuleID :== 123
/* identifiers present in the hashtable */ /* identifiers present in the hashtable */
...@@ -138,19 +139,18 @@ PD_UTSListClass :== 163 ...@@ -138,19 +139,18 @@ PD_UTSListClass :== 163
PD_StdDynamic :== 164 PD_StdDynamic :== 164
PD_TypeCodeClass :== 165 PD_Dyn_DynamicTemp :== 165
PD_TypeObjectType :== 166 PD_Dyn_Type :== 166
PD_TypeConsSymbol :== 167 PD_Dyn_TypeScheme :== 167
PD_unify :== 168 PD_Dyn_TypeApp :== 168
PD_coerce :== 169 PD_Dyn_TypeVar :== 169
PD_PV_Placeholder :== 170 // Pattern variable (occurs only in pattern) PD_Dyn_TypePatternVar :== 170
PD_UPV_Placeholder :== 171 // Universal Pattern Variable (occurs only in pattern; universally quantified variable) PD_Dyn_TypeCons :== 171
PD_UV_Placeholder :== 172 // Universal Variable (occurs only in dynamic; universally quantified variable) PD_Dyn_tc_name :== 172
PD_undo_indirections :== 173 PD_Dyn_Unifier :== 173
PD_Dyn_unify :== 174
PD_TypeID :== 174 PD_Dyn_initial_unifier :== 175
PD_ModuleID :== 175 PD_Dyn_normalise :== 176
PD_ModuleConsSymbol :== 176
/* Generics */ /* Generics */
PD_StdGeneric :== 177 PD_StdGeneric :== 177
...@@ -202,7 +202,9 @@ PD_bimapId :== 216 ...@@ -202,7 +202,9 @@ PD_bimapId :== 216
PD_TypeGenericDict :== 217 PD_TypeGenericDict :== 217
PD_NrOfPredefSymbols :== 218 PD_ModuleConsSymbol :== 218
PD_NrOfPredefSymbols :== 219
GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2 GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2
GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2 GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2
...@@ -219,10 +221,6 @@ buildPredefinedModule :: !*PredefinedSymbols -> (!ScannedModule, !.PredefinedSym ...@@ -219,10 +221,6 @@ buildPredefinedModule :: !*PredefinedSymbols -> (!ScannedModule, !.PredefinedSym
// changes requires recompile of {static,dynamic}-linker plus all dynamics ever made // changes requires recompile of {static,dynamic}-linker plus all dynamics ever made
UnderscoreSystemDynamicModule_String :== "_SystemDynamic" UnderscoreSystemDynamicModule_String :== "_SystemDynamic"
DynamicRepresentation_String :== "DynamicTemp"
T_ypeObjectTypeRepresentation_String :== "T_ypeObjectType"
// List-type // List-type
PD_ListType_String :== "_List" PD_ListType_String :== "_List"
PD_ConsSymbol_String :== "_Cons" PD_ConsSymbol_String :== "_Cons"
......
...@@ -69,9 +69,10 @@ PD_TypeVar_a31 :== 119 ...@@ -69,9 +69,10 @@ PD_TypeVar_a31 :== 119
/* Dynamics */ /* Dynamics */
PD_TypeCodeMember :== 120 PD_TypeCodeMember :== 120
PD_DynamicTemp :== 121 PD_TypeCodeClass :== 121
PD_DynamicValue :== 122 PD_Dyn_bind_global_type_pattern_var
PD_DynamicType :== 123 :== 122
PD_Dyn_ModuleID :== 123
/* identifiers present in the hashtable */ /* identifiers present in the hashtable */
...@@ -138,19 +139,18 @@ PD_UTSListClass :== 163 ...@@ -138,19 +139,18 @@ PD_UTSListClass :== 163
PD_StdDynamic :== 164 PD_StdDynamic :== 164
PD_TypeCodeClass :== 165 PD_Dyn_DynamicTemp :== 165
PD_TypeObjectType :== 166 PD_Dyn_Type :== 166
PD_TypeConsSymbol :== 167 PD_Dyn_TypeScheme :== 167
PD_unify :== 168 PD_Dyn_TypeApp :== 168
PD_coerce :== 169 PD_Dyn_TypeVar :== 169
PD_PV_Placeholder :== 170 // Pattern variable (occurs only in pattern) PD_Dyn_TypePatternVar :== 170
PD_UPV_Placeholder :== 171 // Universal Pattern Variable (occurs only in pattern; universally quantified variable) PD_Dyn_TypeCons :== 171
PD_UV_Placeholder :== 172 // Universal Variable (occurs only in dynamic; universally quantified variable) PD_Dyn_tc_name :== 172
PD_undo_indirections :== 173 PD_Dyn_Unifier :== 173
PD_Dyn_unify :== 174
PD_TypeID :== 174 PD_Dyn_initial_unifier :== 175
PD_ModuleID :== 175 PD_Dyn_normalise :== 176
PD_ModuleConsSymbol :== 176
/* Generics */ /* Generics */
PD_StdGeneric :== 177 PD_StdGeneric :== 177
...@@ -202,7 +202,9 @@ PD_bimapId :== 216 ...@@ -202,7 +202,9 @@ PD_bimapId :== 216
PD_TypeGenericDict :== 217 PD_TypeGenericDict :== 217
PD_NrOfPredefSymbols :== 218