From 8cb390b37ba87283c396da03f96a81d6728f7884 Mon Sep 17 00:00:00 2001 From: johnvg Date: Mon, 23 Jul 2001 12:34:55 +0000 Subject: expand macros with curried macro calls later, to prevent a bug if dcl caching is used git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@561 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d --- frontend/transform.icl | 92 ++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 89 insertions(+), 3 deletions(-) diff --git a/frontend/transform.icl b/frontend/transform.icl index 4b7d713..ece4d0d 100644 --- a/frontend/transform.icl +++ b/frontend/transform.icl @@ -338,6 +338,8 @@ where SK_Function {glob_module,glob_object} | ui_convert_module_n==glob_module # (Yes conversion_table) = ui_conversion_table +// | glob_object>=size conversion_table.[cFunctionDefs] +// -> abort ("unfold(App) "+++toString app.app_symb.symb_name+++" "+++toString glob_object+++" "+++toString (size conversion_table.[cFunctionDefs])) # app={app & app_symb.symb_kind=SK_Function {glob_module=glob_module,glob_object=conversion_table.[cFunctionDefs].[glob_object]}} -> unfold_function_app app ui us -> unfold_function_app app ui us @@ -849,7 +851,7 @@ where expand_simple_macro mod_index macro_index macro=:{fun_body = CheckedBody body, fun_info, fun_symb, fun_pos,fun_kind} (macro_defs, modules, pi=:{pi_symbol_table,pi_symbol_heap,pi_var_heap,pi_error}) - | macros_are_simple fun_info.fi_calls macro_defs + | macros_are_simple fun_info.fi_calls macro_defs && has_no_curried_macro body.cb_rhs macro_defs # identPos = newPosition fun_symb fun_pos # expand_in_imp_module=case fun_kind of FK_ImpMacro->True; _ -> False es = { es_symbol_table = pi_symbol_table, es_var_heap = pi_var_heap, @@ -866,10 +868,11 @@ where # pi = { pi & pi_deps = [macro_index:pi.pi_deps] } = ({ macro_defs & [macro_index] = { macro & fun_body = RhsMacroBody body }}, modules, pi) + macros_are_simple :: [FunCall] {#FunDef} -> Bool; macros_are_simple [] macro_defs = True macros_are_simple [ {fc_index} : calls ] macro_defs - # {fun_kind,fun_body} = macro_defs.[fc_index] + # {fun_kind,fun_body, fun_symb} = macro_defs.[fc_index] = is_a_pattern_macro fun_kind fun_body && macros_are_simple calls macro_defs where is_a_pattern_macro FK_DefMacro (TransformedBody {tb_args}) @@ -937,6 +940,88 @@ add_macros_to_current_group new_macro_fun_def_index n_fun_defs_after_expanding_m // # pi_next_group=pi_next_group+1 = add_macros_to_current_group (new_macro_fun_def_index+1) n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group [new_macro_fun_def_index:macros] +has_no_curried_macro cb_rhs fun_defs + = has_no_curried_macro_CheckedAlternative cb_rhs +where + has_no_curried_macro_CheckedAlternative [{ca_rhs}:cas] + = has_no_curried_macro_Expression ca_rhs && has_no_curried_macro_CheckedAlternative cas + has_no_curried_macro_CheckedAlternative [] + = True + + has_no_curried_macro_Expression (App app=:{app_symb={symb_arity, symb_kind = SK_Macro {glob_object,glob_module}}, app_args}) + | fun_defs.[glob_object].fun_arity<>symb_arity + = False; + = has_no_curried_macro_Expressions app_args + has_no_curried_macro_Expression (App app=:{app_args}) + = has_no_curried_macro_Expressions app_args + has_no_curried_macro_Expression (expr @ exprs) + = has_no_curried_macro_Expression expr && has_no_curried_macro_Expressions exprs + has_no_curried_macro_Expression (Let {let_strict_binds, let_lazy_binds, let_expr}) + = has_no_curried_macro_LetBinds let_strict_binds && has_no_curried_macro_LetBinds let_lazy_binds && has_no_curried_macro_Expression let_expr + where + has_no_curried_macro_LetBinds [{lb_src}:xs] + = has_no_curried_macro_Expression lb_src && has_no_curried_macro_LetBinds xs + has_no_curried_macro_LetBinds [] + = True + has_no_curried_macro_Expression (Case {case_expr,case_guards,case_default}) + = has_no_curried_macro_Expression case_expr && has_no_curried_macro_CasePatterns case_guards && has_no_curried_macro_OptionalExpression case_default + where + has_no_curried_macro_CasePatterns (AlgebraicPatterns type patterns) + = has_no_curried_macro_AlgebraicPatterns patterns + where + has_no_curried_macro_AlgebraicPatterns [{ap_expr}:patterns] + = has_no_curried_macro_Expression ap_expr && has_no_curried_macro_AlgebraicPatterns patterns + has_no_curried_macro_AlgebraicPatterns [] + = True + has_no_curried_macro_CasePatterns (BasicPatterns type patterns) + = has_no_curried_macro_BasicPatterns patterns + where + has_no_curried_macro_BasicPatterns [{bp_expr}:patterns] + = has_no_curried_macro_Expression bp_expr && has_no_curried_macro_BasicPatterns patterns + has_no_curried_macro_BasicPatterns [] + = True + has_no_curried_macro_CasePatterns (DynamicPatterns patterns) + = has_no_curried_macro_DynamicPatterns patterns + where + has_no_curried_macro_DynamicPatterns [{dp_rhs}:patterns] + = has_no_curried_macro_Expression dp_rhs && has_no_curried_macro_DynamicPatterns patterns + has_no_curried_macro_DynamicPatterns [] + = True + + has_no_curried_macro_OptionalExpression (Yes expr) + = has_no_curried_macro_Expression expr + has_no_curried_macro_OptionalExpression No + = True + has_no_curried_macro_Expression (Selection is_unique expr selectors) + = has_no_curried_macro_Expression expr && has_no_curried_macro_Selections selectors + has_no_curried_macro_Expression (Update expr1 selectors expr2) + = has_no_curried_macro_Expression expr1 && has_no_curried_macro_Expression expr2 && has_no_curried_macro_Selections selectors + has_no_curried_macro_Expression (RecordUpdate cons_symbol expression expressions) + = has_no_curried_macro_Expression expression && has_no_curried_macro_Binds expressions + where + has_no_curried_macro_Binds [{bind_src}:binds] + = has_no_curried_macro_Expression bind_src && has_no_curried_macro_Binds binds + has_no_curried_macro_Binds [] + = True + has_no_curried_macro_Expression (TupleSelect symbol argn_nr expr) + = has_no_curried_macro_Expression expr + has_no_curried_macro_Expression (MatchExpr opt_tuple cons_symb expr) + = has_no_curried_macro_Expression expr + has_no_curried_macro_Expression expr + = True + + has_no_curried_macro_Expressions [x:xs] + = has_no_curried_macro_Expression x && has_no_curried_macro_Expressions xs + has_no_curried_macro_Expressions [] + = True + + has_no_curried_macro_Selections [ArraySelection array_select expr_ptr index_expr:selections] + = has_no_curried_macro_Expression index_expr && has_no_curried_macro_Selections selections + has_no_curried_macro_Selections [record_selection:selections] + = has_no_curried_macro_Selections selections + has_no_curried_macro_Selections [] + = True + partitionateAndLiftFunctions :: ![IndexRange] !Index !PredefSymbolsForTransform !*{# FunDef} !*{# DclModule} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin -> (!*{! Group}, !*{# FunDef}, !.{# DclModule}, !*VarHeap, !*ExpressionHeap, !*SymbolTable, !*ErrorAdmin ) partitionateAndLiftFunctions ranges main_dcl_module_n predef_symbols_for_transform fun_defs modules var_heap symbol_heap symbol_table error @@ -1305,7 +1390,7 @@ where # (macro, es) = es!es_fun_defs.[glob_object] #! macro_group_index=macro.fun_info.fi_group_index # es = {es & es_fun_defs.[glob_object].fun_info.fi_group_index= if (macro_group_index>NoIndex) (-2-macro_group_index) macro_group_index} - | macro.fun_arity == symb_arity + | macro.fun_arity == symb_arity = unfoldMacro macro app_args (calls, es) # macro = {macro & fun_info.fi_group_index=if (macro_group_index