diff options
| author | johnvg | 2001-12-05 12:25:52 +0000 |
|---|---|---|
| committer | johnvg | 2001-12-05 12:25:52 +0000 |
| commit | 55e593fde5249c7216729d7e21a9dcab47362874 (patch) | |
| tree | bcdf53e941d97afaec79d2e3991e4f21e134b027 /frontend | |
| parent | forgot to some definitions to export (diff) | |
removed type from BasicExpr
added BVInt
removed symb_arity from SymbIdent
git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@918 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
Diffstat (limited to 'frontend')
| -rw-r--r-- | frontend/StdCompare.icl | 5 | ||||
| -rw-r--r-- | frontend/check.icl | 18 | ||||
| -rw-r--r-- | frontend/checkFunctionBodies.icl | 37 | ||||
| -rw-r--r-- | frontend/comparedefimp.icl | 6 | ||||
| -rw-r--r-- | frontend/convertDynamics.icl | 17 | ||||
| -rw-r--r-- | frontend/convertcases.icl | 10 | ||||
| -rw-r--r-- | frontend/explicitimports.icl | 2 | ||||
| -rw-r--r-- | frontend/generics.icl | 24 | ||||
| -rw-r--r-- | frontend/overloading.icl | 54 | ||||
| -rw-r--r-- | frontend/parse.icl | 34 | ||||
| -rw-r--r-- | frontend/postparse.icl | 238 | ||||
| -rw-r--r-- | frontend/predef.dcl | 2 | ||||
| -rw-r--r-- | frontend/predef.icl | 2 | ||||
| -rw-r--r-- | frontend/syntax.dcl | 17 | ||||
| -rw-r--r-- | frontend/syntax.icl | 30 | ||||
| -rw-r--r-- | frontend/trans.icl | 162 | ||||
| -rw-r--r-- | frontend/transform.icl | 36 | ||||
| -rw-r--r-- | frontend/type.icl | 73 |
18 files changed, 401 insertions, 366 deletions
diff --git a/frontend/StdCompare.icl b/frontend/StdCompare.icl index 10a9455..e14b52f 100644 --- a/frontend/StdCompare.icl +++ b/frontend/StdCompare.icl @@ -54,7 +54,10 @@ where instance == BasicValue where - (==) (BVI int1) (BVI int2) = int1 == int2 + (==) (BVI int1) (BVI int2) = int1 == int2 + (==) (BVI int1) (BVInt int2) = int1 == toString int2 + (==) (BVInt int1) (BVI int2) = toString int1 == int2 + (==) (BVInt int1) (BVInt int2) = int1 == int2 (==) (BVC char1) (BVC char2) = char1 == char2 (==) (BVB bool1) (BVB bool2) = bool1 == bool2 (==) (BVR real1) (BVR real2) = real1 == real2 diff --git a/frontend/check.icl b/frontend/check.icl index 3ec10e9..f42a1f2 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -2158,12 +2158,12 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo = (icl_functions, heaps) = (icl_functions, heaps) - build_function new_fun_index fun_def=:{fun_symb, fun_arity, fun_body = CheckedBody {cb_args}, fun_info} fun_index fun_type + build_function new_fun_index fun_def=:{fun_symb, fun_body = CheckedBody {cb_args}, fun_info} fun_index fun_type (var_heap, type_var_heap, expr_heap) # (tb_args, var_heap) = mapSt new_free_var cb_args var_heap (app_args, expr_heap) = mapSt new_bound_var tb_args expr_heap (app_info_ptr, expr_heap) = newPtr EI_Empty expr_heap - tb_rhs = App { app_symb = { symb_name = fun_symb, symb_arity = fun_arity, + tb_rhs = App { app_symb = { symb_name = fun_symb, symb_kind = SK_Function { glob_module = main_dcl_module_n, glob_object = fun_index }}, app_args = app_args, app_info_ptr = app_info_ptr } @@ -2849,7 +2849,7 @@ where # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_PredefinedModule] | pre_mod.pds_def == mod_index = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols} - <=< adjustPredefSymbol PD_StringType mod_index STE_Type + <=< adjustPredefSymbolAndCheckIndex PD_StringType mod_index PD_StringTypeIndex STE_Type <=< adjust_predef_symbols PD_ListType PD_UnboxedArrayType mod_index STE_Type <=< adjust_predef_symbols PD_ConsSymbol PD_Arity32TupleSymbol mod_index STE_Constructor <=< adjustPredefSymbol PD_TypeCodeClass mod_index STE_Class @@ -2953,6 +2953,18 @@ where = ste_index = NoIndex +adjustPredefSymbolAndCheckIndex predef_index mod_index symbol_index symb_kind cs=:{cs_symbol_table,cs_error} + # pre_id = predefined_idents.[predef_index] + #! pre_index = determine_index_of_symbol (sreadPtr pre_id.id_info cs_symbol_table) symb_kind + | pre_index == symbol_index + = { cs & cs_predef_symbols.[predef_index] = { pds_def = pre_index, pds_module = mod_index }} + = { cs & cs_error = checkError pre_id " function not defined or wrong index in predef" cs_error } +where + determine_index_of_symbol {ste_kind, ste_index} symb_kind + | ste_kind == symb_kind + = ste_index + = NoIndex + NewEntry symbol_table symb_ptr def_kind def_index level previous :== symbol_table <:= (symb_ptr,{ ste_kind = def_kind, ste_index = def_index, ste_def_level = level, ste_previous = previous }) diff --git a/frontend/checkFunctionBodies.icl b/frontend/checkFunctionBodies.icl index 2b729d6..8ad3ee7 100644 --- a/frontend/checkFunctionBodies.icl +++ b/frontend/checkFunctionBodies.icl @@ -68,7 +68,7 @@ make_unboxed_list type_symbol expr_heap cs # (stdStrictLists_index,cons_u_index,decons_u_index,nil_u_index,decons_u_ident,cs) = get_unboxed_list_indices_and_decons_u_ident cs # unboxed_list=UnboxedList type_symbol stdStrictLists_index decons_u_index nil_u_index # (new_info_ptr,expr_heap) = newPtr EI_Empty expr_heap - # decons_expr = App {app_symb={symb_name=decons_u_ident,symb_arity=0,symb_kind=SK_OverloadedFunction {glob_object=decons_u_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr} + # decons_expr = App {app_symb={symb_name=decons_u_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_u_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr} = (unboxed_list,decons_expr,expr_heap,cs) get_unboxed_tail_strict_list_indices_and_decons_u_ident :: *CheckState -> (!Index,!Index,!Index,!Index,!Ident,!*CheckState); @@ -85,7 +85,7 @@ make_unboxed_tail_strict_list type_symbol expr_heap cs # (stdStrictLists_index,cons_uts_index,decons_uts_index,nil_uts_index,decons_uts_ident,cs) = get_unboxed_tail_strict_list_indices_and_decons_u_ident cs # unboxed_list=UnboxedTailStrictList type_symbol stdStrictLists_index decons_uts_index nil_uts_index # (new_info_ptr,expr_heap) = newPtr EI_Empty expr_heap - # decons_expr = App {app_symb={symb_name=decons_uts_ident,symb_arity=0,symb_kind=SK_OverloadedFunction {glob_object=decons_uts_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr} + # decons_expr = App {app_symb={symb_name=decons_uts_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_uts_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr} = (unboxed_list,decons_expr,expr_heap,cs) get_overloaded_list_indices_and_decons_ident :: *CheckState -> (!Index,!Index,!Index,!Index,!Ident,!*CheckState); @@ -102,7 +102,7 @@ make_overloaded_list type_symbol expr_heap cs # (stdStrictLists_index,cons_index,decons_index,nil_index,decons_ident,cs) = get_overloaded_list_indices_and_decons_ident cs # overloaded_list=OverloadedList type_symbol stdStrictLists_index decons_index nil_index # (new_info_ptr,expr_heap) = newPtr EI_Empty expr_heap - # decons_expr = App {app_symb={symb_name=decons_ident,symb_arity=0,symb_kind=SK_OverloadedFunction {glob_object=decons_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr} + # decons_expr = App {app_symb={symb_name=decons_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr} = (overloaded_list,decons_expr,expr_heap,cs) make_case_guards cons_symbol type_symbol alg_patterns expr_heap cs @@ -1036,10 +1036,9 @@ checkExpression free_vars (PE_Update expr1 selectors expr2) e_input e_state e_in = (Update expr1 selectors expr2, free_vars, e_state, e_info, cs) checkExpression free_vars (PE_Tuple exprs) e_input e_state e_info cs # (exprs, arity, free_vars, e_state, e_info, cs) = check_expression_list free_vars exprs e_input e_state e_info cs - ({glob_object={ds_ident,ds_index, ds_arity},glob_module}, cs) + ({glob_object={ds_ident,ds_index},glob_module}, cs) = getPredefinedGlobalSymbol (GetTupleConsIndex arity) PD_PredefinedModule STE_Constructor arity cs - = (App { app_symb = { symb_name = ds_ident, symb_arity = ds_arity, - symb_kind = SK_Constructor { glob_object = ds_index, glob_module = glob_module }}, + = (App { app_symb = { symb_name = ds_ident, symb_kind = SK_Constructor { glob_object = ds_index, glob_module = glob_module }}, app_args = exprs, app_info_ptr = nilPtr }, free_vars, e_state, e_info, cs) where check_expression_list free_vars [] e_input e_state e_info cs @@ -1053,8 +1052,8 @@ checkExpression free_vars rec=:(PE_Record record opt_type fields) e_input=:{ei_e # (opt_record_and_fields, e_info, cs) = checkFields ei_mod_index fields opt_type e_info cs = case opt_record_and_fields of Yes (cons=:{glob_module, glob_object}, _, new_fields) - # {ds_ident,ds_index,ds_arity} = glob_object - rec_cons = { symb_name = ds_ident, symb_kind = SK_Constructor { glob_object = ds_index, glob_module = glob_module }, symb_arity = ds_arity } + # {ds_ident,ds_index} = glob_object + rec_cons = { symb_name = ds_ident, symb_kind = SK_Constructor { glob_object = ds_index, glob_module = glob_module } } -> case record of PE_Empty # (exprs, free_vars, e_state, e_info, cs) = check_field_exprs free_vars new_fields 0 RK_Constructor e_input e_state e_info cs @@ -1135,8 +1134,7 @@ checkExpression free_vars (PE_Dynamic expr opt_type) e_input e_state=:{es_expr_h // ... MV checkExpression free_vars (PE_Basic basic_value) e_input e_state e_info cs - # (basic_type, cs) = typeOfBasicValue basic_value cs - = (BasicExpr basic_value basic_type, free_vars, e_state, e_info, cs) + = (BasicExpr basic_value, free_vars, e_state, e_info, cs) checkExpression free_vars (PE_ABC_Code code_sequence do_inline) e_input e_state e_info cs = (ABCCodeExpr code_sequence do_inline, free_vars, e_state, e_info, cs) @@ -1216,7 +1214,7 @@ checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_stat check_it free_vars mod_index gen_index id kind e_input e_state=:{es_expr_heap} e_info cs #! symb_kind = SK_Generic { glob_object = gen_index, glob_module = mod_index} kind - #! symbol = { symb_name = id, symb_kind = symb_kind, symb_arity = 0 } + #! symbol = { symb_name = id, symb_kind = symb_kind } #! (new_info_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap #! app = { app_symb = symbol, app_args = [], app_info_ptr = new_info_ptr } #! e_state = { e_state & es_expr_heap = es_expr_heap } @@ -1286,7 +1284,7 @@ where { cs & cs_error = checkError id "generic: missing kind argument" cs_error}) check_id_expression entry is_expr_list free_vars id=:{id_info} e_input e_state e_info cs # (symb_kind, arity, priority, is_a_function, e_state, e_info, cs) = determine_info_of_symbol entry id_info e_input e_state e_info cs - symbol = { symb_name = id, symb_kind = symb_kind, symb_arity = 0 } + symbol = { symb_name = id, symb_kind = symb_kind } | is_expr_list = (Constant symbol arity priority is_a_function, free_vars, e_state, e_info, cs) # (app_expr, e_state, cs_error) = buildApplication symbol arity 0 is_a_function [] e_state cs.cs_error @@ -1592,6 +1590,8 @@ checkPattern (PE_ArrayPattern selections) opt_var p_input (var_env, array_patter // further with next alternative check_index_expr (PE_Basic (BVI _)) states = states + check_index_expr (PE_Basic (BVInt _)) states + = states check_index_expr _ (var_env, ap_selections, var_heap, cs) = (var_env, ap_selections, var_heap, { cs & cs_error = checkError "variable or integer constant expected as index expression" "" cs.cs_error }) @@ -1907,10 +1907,10 @@ where unfold_pattern_macro mod_index macro_ident opt_var extra_args (App {app_symb,app_args}) ums = unfold_application mod_index macro_ident opt_var extra_args app_symb app_args ums where - unfold_application mod_index macro_ident opt_var extra_args {symb_kind=SK_Constructor {glob_module,glob_object},symb_name,symb_arity} app_args + unfold_application mod_index macro_ident opt_var extra_args {symb_kind=SK_Constructor {glob_module,glob_object},symb_name} app_args ums=:{ums_cons_defs, ums_modules,ums_error} # (cons_def, cons_index, ums_cons_defs, ums_modules) = get_cons_def mod_index glob_module glob_object ums_cons_defs ums_modules - | cons_def.cons_type.st_arity == symb_arity+length extra_args + | cons_def.cons_type.st_arity == length app_args+length extra_args # (patterns, ums) = mapSt (unfold_pattern_macro mod_index macro_ident No []) app_args { ums & ums_cons_defs = ums_cons_defs, ums_modules = ums_modules } cons_symbol = { glob_object = MakeDefinedSymbol symb_name cons_index cons_def.cons_type.st_arity, glob_module = glob_module } = (AP_Algebraic cons_symbol cons_def.cons_type_index (patterns++extra_args) opt_var, ums) @@ -1925,7 +1925,7 @@ where cons_def = dcl_common.com_cons_defs.[cons_index] = (cons_def, cons_index, cons_defs, modules) - unfold_pattern_macro mod_index macro_ident opt_var extra_args (BasicExpr bv bt) ums=:{ums_error} + unfold_pattern_macro mod_index macro_ident opt_var extra_args (BasicExpr bv) ums=:{ums_error} | not (isEmpty extra_args) = (AP_Empty macro_ident, { ums & ums_error = checkError macro_ident "too much arguments for pattern macro" ums_error }) = (AP_Basic bv opt_var, ums) @@ -2233,11 +2233,11 @@ buildApplication symbol form_arity act_arity is_fun args e_state=:{es_expr_heap} | is_fun # (new_info_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap | form_arity < act_arity - # app = { app_symb = { symbol & symb_arity = form_arity }, app_args = take form_arity args, app_info_ptr = new_info_ptr } + # app = { app_symb = symbol , app_args = take form_arity args, app_info_ptr = new_info_ptr } = (App app @ drop form_arity args, { e_state & es_expr_heap = es_expr_heap }, error) - # app = { app_symb = { symbol & symb_arity = act_arity }, app_args = take form_arity args, app_info_ptr = new_info_ptr } + # app = { app_symb = symbol , app_args = take form_arity args, app_info_ptr = new_info_ptr } = (App app, { e_state & es_expr_heap = es_expr_heap }, error) - # app = App { app_symb = { symbol & symb_arity = act_arity }, app_args = args, app_info_ptr = nilPtr } + # app = App { app_symb = symbol , app_args = args, app_info_ptr = nilPtr } | form_arity < act_arity = (app, e_state, checkError symbol.symb_name "used with too many arguments" error) = (app, e_state, error) @@ -2284,6 +2284,7 @@ where typeOfBasicValue :: !BasicValue !*CheckState -> (!BasicType, !*CheckState) typeOfBasicValue (BVI _) cs = (BT_Int, cs) +typeOfBasicValue (BVInt _) cs = (BT_Int, cs) typeOfBasicValue (BVC _) cs = (BT_Char, cs) typeOfBasicValue (BVB _) cs = (BT_Bool, cs) typeOfBasicValue (BVR _) cs = (BT_Real, cs) diff --git a/frontend/comparedefimp.icl b/frontend/comparedefimp.icl index 1eff2a9..787a1d7 100644 --- a/frontend/comparedefimp.icl +++ b/frontend/comparedefimp.icl @@ -677,7 +677,6 @@ instance t_corresponds (TypeDef TypeRhs) where tc_state = init_atype_vars iclDef.td_args tc_state = t_corresponds (dclDef.td_args, (dclDef.td_rhs, (dclDef.td_context, dclDef.td_attribute))) (iclDef.td_args, (iclDef.td_rhs, (iclDef.td_context, iclDef.td_attribute))) tc_state - instance t_corresponds TypeContext where t_corresponds dclDef iclDef = t_corresponds dclDef.tc_class iclDef.tc_class @@ -938,9 +937,8 @@ instance e_corresponds Expression where = e_corresponds dcl_ds icl_ds o` equal2 dcl_field_nr icl_field_nr o` e_corresponds dcl_expr icl_expr - e_corresponds (BasicExpr dcl_value dcl_type) (BasicExpr icl_value icl_type) + e_corresponds (BasicExpr dcl_value) (BasicExpr icl_value) = equal2 dcl_value icl_value - o` equal2 dcl_type icl_type e_corresponds (AnyCodeExpr dcl_ins dcl_outs dcl_code_sequence) (AnyCodeExpr icl_ins icl_outs icl_code_sequence) = e_corresponds dcl_ins icl_ins o` e_corresponds dcl_outs icl_outs @@ -1075,7 +1073,7 @@ instance e_corresponds {#Char} where instance e_corresponds BoundVar where e_corresponds dcl icl = e_corresponds_VarInfoPtr icl.var_name dcl.var_info_ptr icl.var_info_ptr - + instance e_corresponds FieldSymbol where e_corresponds dclField iclField = equal2 dclField.fs_name iclField.fs_name diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl index a76e0e0..6bfef36 100644 --- a/frontend/convertDynamics.icl +++ b/frontend/convertDynamics.icl @@ -140,7 +140,7 @@ convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_ // get tuple arity 2 constructor # ({pds_module, pds_def}, predefined_symbols) = predefined_symbols![GetTupleConsIndex arity] # pds_ident = predefined_idents.[GetTupleConsIndex arity] - # twoTuple_symb = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def}, symb_arity = arity } + # twoTuple_symb = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def} } // get tuple, type and value selectors # ({pds_def}, predefined_symbols) = predefined_symbols![GetTupleConsIndex arity] @@ -159,7 +159,6 @@ convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_ = { SymbIdent | symb_name = rt_constructor.ds_ident , symb_kind = SK_Constructor {glob_module = pds_module1, glob_object = rt_constructor.ds_index} - , symb_arity = rt_constructor.ds_arity } // type field @@ -407,8 +406,8 @@ where convertDynamics cinp bound_vars default_expr (TupleSelect definedSymbol int expression) ci # (expression,ci) = convertDynamics cinp bound_vars default_expr expression ci = (TupleSelect definedSymbol int expression, ci) - convertDynamics _ _ _ (BasicExpr basicValue basicType) ci - = (BasicExpr basicValue basicType, ci) + convertDynamics _ _ _ be=:(BasicExpr basicValue) ci + = (be, ci) convertDynamics _ _ _ (AnyCodeExpr codeBinding1 codeBinding2 strings) ci = (AnyCodeExpr codeBinding1 codeBinding2 strings, ci) convertDynamics _ _ _ (ABCCodeExpr strings bool) ci @@ -937,7 +936,7 @@ where = ci; # ({pds_module, pds_def}, ci_predef_symb) = ci_predef_symb![PD_ModuleConsSymbol] # pds_ident = predefined_idents.[PD_ModuleConsSymbol] - # module_symb1 = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def}, symb_arity = 0 } + # module_symb1 = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def} } # ci = { ci & ci_predef_symb = ci_predef_symb }; @@ -1181,7 +1180,7 @@ addToBoundVars var type bound_vars get_constructor :: !{!GlobalTCType} Index -> Expression get_constructor glob_type_inst index - = BasicExpr (BVS ("\"" +++ toString glob_type_inst.[index] +++ "\"")) (BT_String TE) + = BasicExpr (BVS ("\"" +++ toString glob_type_inst.[index] +++ "\"")) getResultType :: ExprInfoPtr !*ConversionInfo -> (!AType, !*ConversionInfo) getResultType case_info_ptr ci=:{ci_expr_heap} @@ -1193,7 +1192,7 @@ getSymbol index symb_kind arity ci=:{ci_predef_symb} # ({pds_module, pds_def}, ci_predef_symb) = ci_predef_symb![index] # pds_ident = predefined_idents.[index] ci = {ci & ci_predef_symb = ci_predef_symb} - symbol = { symb_name = pds_ident, symb_kind = symb_kind { glob_module = pds_module, glob_object = pds_def}, symb_arity = arity } + symbol = { symb_name = pds_ident, symb_kind = symb_kind { glob_module = pds_module, glob_object = pds_def} } = (symbol, ci) getTupleSymbol arity ci=:{ci_predef_symb} @@ -1283,7 +1282,7 @@ get_module_id_app predef_symbols # ({pds_module, pds_def}, predef_symbols) = predef_symbols![PD_ModuleConsSymbol] # pds_ident = predefined_idents.[PD_ModuleConsSymbol] # module_symb = - { app_symb = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def}, symb_arity = 0 } + { app_symb = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def} } , app_args = [] , app_info_ptr = nilPtr } @@ -1291,7 +1290,7 @@ get_module_id_app predef_symbols # ({pds_module, pds_def}, predef_symbols) = predef_symbols![PD_ModuleID] # pds_ident = predefined_idents.[PD_ModuleID] # module_id_symb = - { app_symb = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def}, symb_arity = 1 } + { app_symb = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def} } , app_args = [App module_symb] , app_info_ptr = nilPtr } diff --git a/frontend/convertcases.icl b/frontend/convertcases.icl index a3bf43c..8be6420 100644 --- a/frontend/convertcases.icl +++ b/frontend/convertcases.icl @@ -209,7 +209,7 @@ where weightedRefCount rci (Case case_expr) rs=:{rcs_expr_heap} # (case_info, rcs_expr_heap) = readPtr case_expr.case_info_ptr rcs_expr_heap = weightedRefCountOfCase rci case_expr case_info { rs & rcs_expr_heap = rcs_expr_heap } - weightedRefCount rci expr=:(BasicExpr _ _) rs + weightedRefCount rci expr=:(BasicExpr _) rs = rs weightedRefCount rci (MatchExpr _ constructor expr) rs = weightedRefCount rci expr rs @@ -454,7 +454,7 @@ where # (fun_expr, ds) = distributeLets depth fun_expr ds (exprs, ds) = distributeLets depth exprs ds = (fun_expr @ exprs, ds) - distributeLets depth expr=:(BasicExpr _ _) ds + distributeLets depth expr=:(BasicExpr _) ds = (expr, ds) distributeLets depth (MatchExpr opt_tuple constructor expr) ds # (expr, ds) = distributeLets depth expr ds @@ -734,7 +734,7 @@ newFunctionWithType opt_id fun_bodies local_vars fun_type group_index (cs_next_f , fun_lifted = 0 , fun_info = { EmptyFunInfo & fi_group_index = group_index, fi_local_vars = local_vars } } - = ({ symb_name = fun_id, symb_kind = SK_GeneratedFunction fun_def_ptr cs_next_fun_nr, symb_arity = arity }, + = ({ symb_name = fun_id, symb_kind = SK_GeneratedFunction fun_def_ptr cs_next_fun_nr }, (inc cs_next_fun_nr, [fun_def_ptr : cs_new_functions], cs_fun_heap <:= (fun_def_ptr, FI_Function { gf_fun_def = fun_def, gf_instance_info = II_Empty, gf_fun_index = cs_next_fun_nr, gf_cons_args = {cc_size=0, cc_args = [], cc_linear_bits = [], cc_producer = False} }))) @@ -910,7 +910,7 @@ instance convertRootCases Expression where build_conditional false guard then_expr (Yes else_expr) = Conditional { if_cond = guard, if_then = else_expr, if_else = Yes then_expr } build_conditional false guard then_expr No - = Conditional { if_cond = Conditional { if_cond = guard, if_then = BasicExpr (BVB False) BT_Bool, if_else = Yes (BasicExpr (BVB True) BT_Bool) }, + = Conditional { if_cond = Conditional { if_cond = guard, if_then = BasicExpr (BVB False), if_else = Yes (BasicExpr (BVB True)) }, if_then = then_expr, if_else = No } convert_to_else_part ci sign_of_then_part [ alt=:{bp_value=BVB sign_of_else_part,bp_expr} : alts ] case_default cs @@ -1234,7 +1234,7 @@ where copy (Conditional cond) cp_info # (cond, cp_info) = copy cond cp_info = (Conditional cond, cp_info) - copy expr=:(BasicExpr _ _) cp_info + copy expr=:(BasicExpr _) cp_info = (expr, cp_info) copy (MatchExpr opt_tuple constructor expr) cp_info # (expr, cp_info) = copy expr cp_info diff --git a/frontend/explicitimports.icl b/frontend/explicitimports.icl index ea4d7b5..2076eab 100644 --- a/frontend/explicitimports.icl +++ b/frontend/explicitimports.icl @@ -654,7 +654,7 @@ instance check_completeness Expression where (check_completeness selections cci ccs) check_completeness (TupleSelect _ _ expression) cci ccs = check_completeness expression cci ccs - check_completeness (BasicExpr _ _) _ ccs + check_completeness (BasicExpr _) _ ccs = ccs check_completeness (AnyCodeExpr _ _ _) _ ccs = ccs diff --git a/frontend/generics.icl b/frontend/generics.icl index 590a744..d3ff9bb 100644 --- a/frontend/generics.icl +++ b/frontend/generics.icl @@ -3749,8 +3749,8 @@ buildConsApp cons_mod {ds_ident, ds_index, ds_arity} arg_exprs heaps=:{hp_expres # expr = App { app_symb = { symb_name = ds_ident, - symb_kind = SK_Constructor cons_glob, - symb_arity = ds_arity }, + symb_kind = SK_Constructor cons_glob + }, app_args = arg_exprs, app_info_ptr = expr_info_ptr} # heaps = { heaps & hp_expression_heap = hp_expression_heap } @@ -3764,8 +3764,8 @@ buildFunApp fun_mod {ds_ident, ds_index, ds_arity} arg_exprs heaps=:{hp_expressi # expr = App { app_symb = { symb_name = ds_ident, - symb_kind = SK_Function fun_glob, - symb_arity = length arg_exprs }, + symb_kind = SK_Function fun_glob + }, app_args = arg_exprs, app_info_ptr = expr_info_ptr} # heaps = { heaps & hp_expression_heap = hp_expression_heap } @@ -3779,8 +3779,8 @@ buildGenericApp module_index {ds_ident, ds_index} kind arg_exprs heaps=:{hp_expr # expr = App { app_symb = { symb_name = ds_ident, - symb_kind = SK_Generic glob_index kind, - symb_arity = length arg_exprs }, + symb_kind = SK_Generic glob_index kind + }, app_args = arg_exprs, app_info_ptr = expr_info_ptr} # heaps = { heaps & hp_expression_heap = hp_expression_heap } @@ -3847,8 +3847,7 @@ buildPredefConsApp predef_index args predefs heaps=:{hp_expression_heap} # global_index = {glob_module = pds_module, glob_object = pds_def} # symb_ident = { symb_name = pds_ident, - symb_kind = SK_Constructor global_index, - symb_arity = length args + symb_kind = SK_Constructor global_index } # (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty hp_expression_heap # app = App {app_symb = symb_ident, app_args = args, app_info_ptr = expr_info_ptr} @@ -3869,9 +3868,8 @@ buildPredefFunApp predef_index args predefs heaps=:{hp_expression_heap} # pds_ident = predefined_idents.[predef_index] # global_index = {glob_module = pds_module, glob_object = pds_def} # symb_ident = { - symb_name = pds_ident, - symb_kind = SK_Function global_index, - symb_arity = length args + symb_name = pds_ident, + symb_kind = SK_Function global_index } # (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty hp_expression_heap # app = App {app_symb = symb_ident, app_args = args, app_info_ptr = expr_info_ptr} @@ -4179,14 +4177,14 @@ makeIdent :: String -> Ident makeIdent str = {id_name = str, id_info = nilPtr} makeIntExpr :: Int -> Expression -makeIntExpr value = BasicExpr (BVI (toString value)) BT_Int +makeIntExpr value = BasicExpr (BVI (toString value)) makeStringExpr :: String !PredefinedSymbols -> Expression makeStringExpr str predefs #! {pds_module, pds_def} = predefs.[PD_StringType] #! pds_ident = predefined_idents.[PD_StringType] #! type_symb = MakeTypeSymbIdent { glob_module = pds_module, glob_object = pds_def } pds_ident 0 - = BasicExpr (BVS str) (BT_String (TA type_symb [])) + = BasicExpr (BVS str) makeListExpr :: [Expression] !PredefinedSymbols !*Heaps -> (Expression, !*Heaps) makeListExpr [] predefs heaps diff --git a/frontend/overloading.icl b/frontend/overloading.icl index 0a95fd4..a0f9947 100644 --- a/frontend/overloading.icl +++ b/frontend/overloading.icl @@ -789,29 +789,28 @@ getDictionaryTypeAndConstructor {glob_module, glob_object = {ds_ident,ds_index}} = (class_dictionary, rt_constructor) convertOverloadedCall :: !{#CommonDefs} ![TypeContext] !SymbIdent !ExprInfoPtr ![ClassApplication] !(!*Heaps, ![ExprInfoPtr]) -> (!*Heaps, ![ExprInfoPtr]) -convertOverloadedCall defs contexts {symb_name,symb_kind = SK_OverloadedFunction {glob_module,glob_object}, symb_arity} expr_ptr [class_appl:class_appls] heaps_and_ptrs +convertOverloadedCall defs contexts {symb_name,symb_kind = SK_OverloadedFunction {glob_module,glob_object}} expr_ptr [class_appl:class_appls] heaps_and_ptrs # mem_def = defs.[glob_module].com_member_defs.[glob_object] (class_exprs, heaps_and_ptrs) = convertClassApplsToExpressions defs contexts class_appls heaps_and_ptrs - (inst_expr, (heaps, ptrs)) = adjust_member_application defs contexts mem_def symb_arity class_appl class_exprs heaps_and_ptrs + (inst_expr, (heaps, ptrs)) = adjust_member_application defs contexts mem_def class_appl class_exprs heaps_and_ptrs = ({ heaps & hp_expression_heap = heaps.hp_expression_heap <:= (expr_ptr, inst_expr)}, ptrs) where - adjust_member_application defs contexts {me_symb,me_offset,me_class} symb_arity (CA_Instance red_contexts) class_exprs heaps_and_ptrs + adjust_member_application defs contexts {me_symb,me_offset,me_class} (CA_Instance red_contexts) class_exprs heaps_and_ptrs # ({glob_module,glob_object}, red_contexts) = find_instance_of_member me_class me_offset red_contexts (exprs, heaps_and_ptrs) = convertClassApplsToExpressions defs contexts red_contexts heaps_and_ptrs class_exprs = exprs ++ class_exprs = (EI_Instance { glob_module = glob_module, glob_object = { ds_ident = me_symb, ds_arity = length class_exprs, ds_index = glob_object }} class_exprs, heaps_and_ptrs) - adjust_member_application defs contexts {me_symb,me_offset,me_class={glob_module,glob_object}} symb_arity (CA_Context tc) class_exprs (heaps=:{hp_type_heaps}, ptrs) + adjust_member_application defs contexts {me_symb,me_offset,me_class={glob_module,glob_object}} (CA_Context tc) class_exprs (heaps=:{hp_type_heaps}, ptrs) # (class_context, address, hp_type_heaps) = determineContextAddress contexts defs tc hp_type_heaps {class_dictionary={ds_index,ds_ident}} = defs.[glob_module].com_class_defs.[glob_object] selector = selectFromDictionary glob_module ds_index me_offset defs = (EI_Selection (generateClassSelection address [RecordSelection selector me_offset]) class_context.tc_var class_exprs, ({ heaps & hp_type_heaps = hp_type_heaps }, ptrs)) - - adjust_member_application defs contexts _ _ (CA_GlobalTypeCode {tci_index,tci_contexts}) _ heaps_and_ptrs + adjust_member_application defs contexts _ (CA_GlobalTypeCode {tci_index,tci_contexts}) _ heaps_and_ptrs # (exprs, heaps_and_ptrs) = convertClassApplsToExpressions defs contexts tci_contexts heaps_and_ptrs = (EI_TypeCode (TCE_Constructor tci_index (map expressionToTypeCodeExpression exprs)), heaps_and_ptrs) - adjust_member_application defs contexts _ _ (CA_LocalTypeCode new_var_ptr) _ heaps_and_ptrs + adjust_member_application defs contexts _ (CA_LocalTypeCode new_var_ptr) _ heaps_and_ptrs = (EI_TypeCode (TCE_Var new_var_ptr), heaps_and_ptrs) find_instance_of_member me_class me_offset { rcs_class_context = {rc_class, rc_inst_module, rc_inst_members, rc_red_contexts}, rcs_constraints_contexts} @@ -911,8 +910,8 @@ where {ds_ident,ds_index} = ins_members.[mem_offset] mem_expr = App { app_symb = { symb_name = ds_ident, - symb_kind = SK_Function { glob_object = ds_index, glob_module = mod_index }, - symb_arity = arity }, + symb_kind = SK_Function { glob_object = ds_index, glob_module = mod_index } + }, app_args = class_arguments, app_info_ptr = nilPtr } = build_class_members mem_offset ins_members mod_index class_arguments arity [ mem_expr : dictionary_args ] @@ -920,8 +919,8 @@ where build_dictionary class_symbol instance_types dictionary_args defs expr_heap ptrs # (dict_type, dict_cons) = getDictionaryTypeAndConstructor class_symbol defs record_symbol = { symb_name = dict_cons.ds_ident, - symb_kind = SK_Constructor {glob_module = class_symbol.glob_module, glob_object = dict_cons.ds_index}, - symb_arity = dict_cons.ds_arity } + symb_kind = SK_Constructor {glob_module = class_symbol.glob_module, glob_object = dict_cons.ds_index} + } dict_type_symbol = MakeTypeSymbIdent {glob_module = class_symbol.glob_module, glob_object = dict_type.ds_index} dict_type.ds_ident dict_type.ds_arity class_type = TA dict_type_symbol [ AttributedType type \\ type <- instance_types ] (app_info_ptr, expr_heap) = newPtr (EI_DictionaryType class_type) expr_heap @@ -1265,7 +1264,7 @@ class updateExpression e :: !Index !e !*UpdateInfo -> (!e, !*UpdateInfo) instance updateExpression Expression where - updateExpression group_index (App app=:{app_symb=symb=:{symb_kind,symb_arity,symb_name},app_args,app_info_ptr}) ui + updateExpression group_index (App app=:{app_symb=symb=:{symb_kind,symb_name},app_args,app_info_ptr}) ui # (app_args, ui) = updateExpression group_index app_args ui | isNilPtr app_info_ptr = (App { app & app_args = app_args }, ui) @@ -1279,24 +1278,22 @@ where -> (App { app & app_args = app_args }, ui) # (CheckedType {st_context}, ui) = ui!ui_fun_env.[fun_index] (app_args, (ui_var_heap, ui_error)) = mapAppendSt (build_context_arg symb_name) st_context app_args (ui.ui_var_heap, ui.ui_error) - -> (App { app & app_symb = { symb & symb_arity = symb_arity + length st_context}, app_args = app_args }, - { ui & ui_var_heap = ui_var_heap, ui_error = ui_error }) + -> (App { app & app_args = app_args }, { ui & ui_var_heap = ui_var_heap, ui_error = ui_error }) EI_Context context_args # (app_args, ui=:{ui_var_heap, ui_error}) = adjustClassExpressions symb_name context_args app_args ui #! main_dcl_module_n = ui.ui_x.UpdateInfoX.x_main_dcl_module_n #! fun_index = get_recursive_fun_index group_index symb_kind main_dcl_module_n ui.ui_fun_defs | fun_index == NoIndex - # app = { app & app_symb = { symb & symb_arity = length context_args + symb_arity }, app_args = app_args} + # app = { app & app_args = app_args} -> (App app, examine_calls context_args { ui & ui_var_heap = ui_var_heap, ui_error = ui_error }) # (CheckedType {st_context}, ui) = ui!ui_fun_env.[fun_index] nr_of_context_args = length context_args nr_of_lifted_contexts = length st_context - nr_of_context_args (app_args, (ui_var_heap, ui_error)) = mapAppendSt (build_context_arg symb_name) (take nr_of_lifted_contexts st_context) app_args (ui_var_heap, ui_error) - -> (App { app & app_symb = { symb & symb_arity = nr_of_lifted_contexts + nr_of_context_args + symb_arity }, app_args = app_args }, - examine_calls context_args { ui & ui_var_heap = ui_var_heap, ui_error = ui_error }) + -> (App { app & app_args = app_args }, examine_calls context_args { ui & ui_var_heap = ui_var_heap, ui_error = ui_error }) EI_Instance inst_symbol context_args # (context_args, ui=:{ui_var_heap, ui_error}) = adjustClassExpressions symb_name context_args [] ui - -> (build_application inst_symbol context_args app_args symb_arity app_info_ptr, + -> (build_application inst_symbol context_args app_args app_info_ptr, examine_calls context_args (new_call inst_symbol.glob_module inst_symbol.glob_object.ds_index { ui & ui_var_heap = ui_var_heap, ui_error = ui_error })) EI_Selection selectors record_var context_args @@ -1339,10 +1336,9 @@ where get_recursive_fun_index group_index _ main_dcl_module_n fun_defs = NoIndex - build_application def_symbol=:{glob_object} context_args orig_args nr_of_orig_args app_info_ptr + build_application def_symbol=:{glob_object} context_args orig_args app_info_ptr = App {app_symb = { symb_name = glob_object.ds_ident, - symb_kind = SK_Function { def_symbol & glob_object = glob_object.ds_index }, - symb_arity = glob_object.ds_arity + nr_of_orig_args }, + symb_kind = SK_Function { def_symbol & glob_object = glob_object.ds_index } }, app_args = context_args ++ orig_args, app_info_ptr = app_info_ptr } examine_application (SK_Function {glob_module,glob_object}) ui @@ -1554,7 +1550,7 @@ where = (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}} - # (typecons_symb,ui) = getSymbol PD_TypeConsSymbol SK_Constructor (USE_DummyModuleName 3 2) ui + # (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) @@ -1607,12 +1603,12 @@ where , let_expr_position = NoPos }, ui) convertTypecodes [] ui - # (nil_symb, ui) = getSymbol PD_NilSymbol SK_Constructor 0 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 2 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, @@ -1623,7 +1619,7 @@ where = mapSt create_variable var_info_ptrs ui where create_variable var_info_ptr ui - # (placeholder_symb, ui) = getSymbol PD_variablePlaceholder SK_Constructor 3 ui + # (placeholder_symb, ui) = getSymbol PD_variablePlaceholder 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, @@ -1634,11 +1630,11 @@ where }, { ui & ui_local_vars = [cyclic_fv : ui.ui_local_vars]}) - getSymbol :: !Int !(!(Global !Int) -> !SymbKind) !Int !*UpdateInfo -> (SymbIdent,*UpdateInfo) - getSymbol index symb_kind arity ui=:{ui_x} + 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}, symb_arity = arity } + 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) @@ -1656,7 +1652,7 @@ where # tci_instance = (hd tci_instance).gtci_type // tci_instances.[index] # cons_expr - = BasicExpr (BVS ("\"" +++ toString tci_instance +++ "\"")) (BT_String TE) + = BasicExpr (BVS ("\"" +++ toString tci_instance +++ "\"")) = (cons_expr,ui) a_ij_var_name = { id_name = "a_ij", id_info = nilPtr } diff --git a/frontend/parse.icl b/frontend/parse.icl index 8e0aa74..f81991b 100644 --- a/frontend/parse.icl +++ b/frontend/parse.icl @@ -2282,8 +2282,38 @@ where trySimpleExpressionT CurlyOpenToken is_pattern pState # (rec_or_aray_exp, pState) = wantRecordOrArrayExp is_pattern pState = (True, rec_or_aray_exp, pState) -trySimpleExpressionT (IntToken int) is_pattern pState - = (True, PE_Basic (BVI int), pState) +trySimpleExpressionT (IntToken int_string) is_pattern pState + # (ok,int) = string_to_int int_string + with + string_to_int s + | len==0 + = (False,0) + | s.[0] == '-' + | len>2 && s.[1]=='0' /* octal */ + = (False,0) + # (ok,int) = (string_to_int2 1 0 s) + = (ok,~int) + | s.[0] == '+' + | len>2&& s.[1]=='0' /* octal */ + = (False,0) + = string_to_int2 1 0 s + | s.[0]=='0' && len>1 /* octal */ + = (False,0) + = string_to_int2 0 0 s + where + len = size s + + string_to_int2:: !Int !Int !{#Char} -> (!Bool,!Int) + string_to_int2 posn val s + | len==posn + = (True,val) + # n = toInt (s.[posn]) - toInt '0' + | 0<=n && n<= 9 + = string_to_int2 (posn+1) (n+val*10) s + = (False,0) + | ok + = (True, PE_Basic (BVInt int), pState) + = (True, PE_Basic (BVI int_string), pState) trySimpleExpressionT (StringToken string) is_pattern pState = (True, PE_Basic (BVS string), pState) trySimpleExpressionT (BoolToken bool) is_pattern pState diff --git a/frontend/postparse.icl b/frontend/postparse.icl index f514989..a66dd1c 100644 --- a/frontend/postparse.icl +++ b/frontend/postparse.icl @@ -70,7 +70,7 @@ instance toParsedExpr ParsedExpr where instance toParsedExpr Int where toParsedExpr x - = PE_Basic (BVI (toString x)) + = PE_Basic (BVInt x) postParseError :: Position {#Char} *CollectAdmin -> *CollectAdmin postParseError pos msg ps=:{ca_error={pea_file}} @@ -397,6 +397,10 @@ get_predef_id predef_index :== predefined_idents.[predef_index] :: IndexGenerator :== Optional (ParsedExpr,[([ParsedDefinition],ParsedExpr,ParsedExpr)]) +is_zero_expression (PE_Basic (BVI "0")) = True +is_zero_expression (PE_Basic (BVInt 0)) = True +is_zero_expression _ = False + transformGenerator :: Generator String IndexGenerator *CollectAdmin -> (!TransformedGenerator,!IndexGenerator,!Int,!*CollectAdmin) transformGenerator {gen_kind=IsArrayGenerator, gen_expr, gen_pattern, gen_position} qual_filename index_generator ca # (array, ca) = prefixAndPositionToIdentExp "g_a" gen_position ca @@ -414,10 +418,10 @@ transformGenerator {gen_kind=IsArrayGenerator, gen_expr, gen_pattern, gen_positi No # (i, ca) = prefixAndPositionToIdentExp "g_i" gen_position ca inc = get_predef_id PD_IncFun - # dec_n = PE_List [n,PE_Ident sub,PE_Basic (BVI "1")] + # dec_n = PE_List [n,PE_Ident sub,PE_Basic (BVInt 1)] # transformed_generator = { tg_expr = ([PD_NodeDef (LinePos qual_filename gen_position.lc_line) (PE_Tuple [n,a2]) (exprToRhs (PE_List [PE_Ident usize, gen_expr]))], - [PE_Basic (BVI "0"),dec_n,a2]) + [PE_Basic (BVInt 0),dec_n,a2]) , tg_lhs_arg = [i, n, array] , tg_case_end_expr = PE_List [i,PE_Ident less_or_equal, n] , tg_case_end_pattern = PE_Basic (BVB True) @@ -430,7 +434,7 @@ transformGenerator {gen_kind=IsArrayGenerator, gen_expr, gen_pattern, gen_positi -> (transformed_generator,Yes (i,[([],dec_n,n2)]),2,ca) Yes (i,[]) # inc = get_predef_id PD_IncFun - # dec_n = PE_List [n,PE_Ident sub,PE_Basic (BVI "1")] + # dec_n = PE_List [n,PE_Ident sub,PE_Basic (BVInt 1)] # transformed_generator = { tg_expr = ([PD_NodeDef (LinePos qual_filename gen_position.lc_line) (PE_Tuple [n,a2]) (exprToRhs (PE_List [PE_Ident usize, gen_expr]))], [dec_n,a2]) @@ -458,124 +462,120 @@ transformGenerator {gen_kind=IsArrayGenerator, gen_expr, gen_pattern, gen_positi } # size_expression =([PD_NodeDef (LinePos qual_filename gen_position.lc_line) (PE_Tuple [n,a2]) (exprToRhs (PE_List [PE_Ident usize, gen_expr]))], - (PE_List [n,PE_Ident sub,PE_Basic (BVI "1")]),n2) + (PE_List [n,PE_Ident sub,PE_Basic (BVInt 1)]),n2) -> (transformed_generator,Yes (i,[size_expression:size_expressions]),0,ca) transformGenerator {gen_kind, gen_expr=PE_Sequ (SQ_FromTo from_exp to_exp), gen_pattern, gen_position} qual_filename index_generator ca # (n, ca) = prefixAndPositionToIdentExp "g_s" gen_position ca (gen_var_case1, ca) = prefixAndPositionToIdent "g_c1" gen_position ca (gen_var_case2, ca) = prefixAndPositionToIdent "g_c2" gen_position ca - = case from_exp of - PE_Basic (BVI "0") - -> case index_generator of - No - # (i, ca) = prefixAndPositionToIdentExp "g_i" gen_position ca - # inc = get_predef_id PD_IncFun - less_or_equal = get_predef_id PD_LessOrEqualFun - # transformed_generator - = { tg_expr = ([],[from_exp,to_exp]) - , tg_lhs_arg = [i,n] - , tg_case_end_expr = PE_List [i,PE_Ident less_or_equal,n] - , tg_case_end_pattern = PE_Basic (BVB True) - , tg_element = i - , tg_element_is_uselect=False - , tg_pattern = gen_pattern - , tg_rhs_continuation = [PE_List [PE_Ident inc, i], n] - , tg_case1 = gen_var_case1, tg_case2 = gen_var_case2 - } - -> (transformed_generator,Yes (i,[([],to_exp,n)]),2,ca) - Yes (i,[]) - # inc = get_predef_id PD_IncFun - less_or_equal = get_predef_id PD_LessOrEqualFun - # transformed_generator - = { tg_expr = ([],[to_exp]) - , tg_lhs_arg = [n] - , tg_case_end_expr = PE_List [i,PE_Ident less_or_equal,n] - , tg_case_end_pattern = PE_Basic (BVB True) - , tg_element = i - , tg_element_is_uselect=False - , tg_pattern = gen_pattern - , tg_rhs_continuation = [n] - , tg_case1 = gen_var_case1, tg_case2 = gen_var_case2 - } - -> (transformed_generator,Yes (i,[([],to_exp,n)]),1,ca) - Yes (i,size_expressions) - # transformed_generator - = { tg_expr = ([],[]) - , tg_lhs_arg = [] - , tg_case_end_expr = PE_Empty - , tg_case_end_pattern = PE_Empty - , tg_element = i - , tg_element_is_uselect=False - , tg_pattern = gen_pattern - , tg_rhs_continuation = [] - , tg_case1 = gen_var_case1, tg_case2 = gen_var_case2 - } - -> (transformed_generator,Yes (i,[([],to_exp,n):size_expressions]),0,ca) - _ - # (i, ca) = prefixAndPositionToIdentExp "g_i" gen_position ca - # inc = get_predef_id PD_IncFun - less_or_equal = get_predef_id PD_LessOrEqualFun - # transformed_generator - = { tg_expr = ([],[from_exp,to_exp]) - , tg_lhs_arg = [i,n] - , tg_case_end_expr = PE_List [i,PE_Ident less_or_equal,n] - , tg_case_end_pattern = PE_Basic (BVB True) - , tg_element = i - , tg_element_is_uselect=False - , tg_pattern = gen_pattern - , tg_rhs_continuation = [PE_List [PE_Ident inc, i], n] - , tg_case1 = gen_var_case1, tg_case2 = gen_var_case2 - } - -> (transformed_generator,index_generator,0,ca) + | is_zero_expression from_exp + = case index_generator of + No + # (i, ca) = prefixAndPositionToIdentExp "g_i" gen_position ca + # inc = get_predef_id PD_IncFun + less_or_equal = get_predef_id PD_LessOrEqualFun + # transformed_generator + = { tg_expr = ([],[from_exp,to_exp]) + , tg_lhs_arg = [i,n] + , tg_case_end_expr = PE_List [i,PE_Ident less_or_equal,n] + , tg_case_end_pattern = PE_Basic (BVB True) + , tg_element = i + , tg_element_is_uselect=False + , tg_pattern = gen_pattern + , tg_rhs_continuation = [PE_List [PE_Ident inc, i], n] + , tg_case1 = gen_var_case1, tg_case2 = gen_var_case2 + } + -> (transformed_generator,Yes (i,[([],to_exp,n)]),2,ca) + Yes (i,[]) + # inc = get_predef_id PD_IncFun + less_or_equal = get_predef_id PD_LessOrEqualFun + # transformed_generator + = { tg_expr = ([],[to_exp]) + , tg_lhs_arg = [n] + , tg_case_end_expr = PE_List [i,PE_Ident less_or_equal,n] + , tg_case_end_pattern = PE_Basic (BVB True) + , tg_element = i + , tg_element_is_uselect=False + , tg_pattern = gen_pattern + , tg_rhs_continuation = [n] + , tg_case1 = gen_var_case1, tg_case2 = gen_var_case2 + } + -> (transformed_generator,Yes (i,[([],to_exp,n)]),1,ca) + Yes (i,size_expressions) + # transformed_generator + = { tg_expr = ([],[]) + , tg_lhs_arg = [] + , tg_case_end_expr = PE_Empty + , tg_case_end_pattern = PE_Empty + , tg_element = i + , tg_element_is_uselect=False + , tg_pattern = gen_pattern + , tg_rhs_continuation = [] + , tg_case1 = gen_var_case1, tg_case2 = gen_var_case2 + } + -> (transformed_generator,Yes (i,[([],to_exp,n):size_expressions]),0,ca) + # (i, ca) = prefixAndPositionToIdentExp "g_i" gen_position ca + # inc = get_predef_id PD_IncFun + less_or_equal = get_predef_id PD_LessOrEqualFun + # transformed_generator + = { tg_expr = ([],[from_exp,to_exp]) + , tg_lhs_arg = [i,n] + , tg_case_end_expr = PE_List [i,PE_Ident less_or_equal,n] + , tg_case_end_pattern = PE_Basic (BVB True) + , tg_element = i + , tg_element_is_uselect=False + , tg_pattern = gen_pattern + , tg_rhs_continuation = [PE_List [PE_Ident inc, i], n] + , tg_case1 = gen_var_case1, tg_case2 = gen_var_case2 + } + = (transformed_generator,index_generator,0,ca) transformGenerator {gen_kind, gen_expr=PE_Sequ (SQ_From from_exp), gen_pattern, gen_position} qual_filename index_generator ca # (gen_var_case1, ca) = prefixAndPositionToIdent "g_c1" gen_position ca (gen_var_case2, ca) = prefixAndPositionToIdent "g_c2" gen_position ca - = case from_exp of - PE_Basic (BVI "0") - -> case index_generator of - No - # (i, ca) = prefixAndPositionToIdentExp "g_i" gen_position ca - # inc = get_predef_id PD_IncFun - # transformed_generator - = { tg_expr = ([],[from_exp]) - , tg_lhs_arg = [i] - , tg_case_end_expr = PE_Empty - , tg_case_end_pattern = PE_Empty - , tg_element = i - , tg_element_is_uselect=False - , tg_pattern = gen_pattern - , tg_rhs_continuation = [PE_List [PE_Ident inc, i]] - , tg_case1 = gen_var_case1, tg_case2 = gen_var_case2 - } - -> (transformed_generator,Yes (i,[]),0,ca) - Yes (i,size_expressions) - # transformed_generator - = { tg_expr = ([],[]) - , tg_lhs_arg = [] - , tg_case_end_expr = PE_Empty - , tg_case_end_pattern = PE_Empty - , tg_element = i - , tg_element_is_uselect=False - , tg_pattern = gen_pattern - , tg_rhs_continuation = [] - , tg_case1 = gen_var_case1, tg_case2 = gen_var_case2 - } - -> (transformed_generator,index_generator,0,ca) - _ - # (i, ca) = prefixAndPositionToIdentExp "g_i" gen_position ca - # inc = get_predef_id PD_IncFun - # transformed_generator - = { tg_expr = ([],[from_exp]) - , tg_lhs_arg = [i] - , tg_case_end_expr = PE_Empty - , tg_case_end_pattern = PE_Empty - , tg_element = i - , tg_element_is_uselect=False - , tg_pattern = gen_pattern - , tg_rhs_continuation = [PE_List [PE_Ident inc, i]] - , tg_case1 = gen_var_case1, tg_case2 = gen_var_case2 - } - -> (transformed_generator,index_generator,0,ca) + | is_zero_expression from_exp + = case index_generator of + No + # (i, ca) = prefixAndPositionToIdentExp "g_i" gen_position ca + # inc = get_predef_id PD_IncFun + # transformed_generator + = { tg_expr = ([],[from_exp]) + , tg_lhs_arg = [i] + , tg_case_end_expr = PE_Empty + , tg_case_end_pattern = PE_Empty + , tg_element = i + , tg_element_is_uselect=False + , tg_pattern = gen_pattern + , tg_rhs_continuation = [PE_List [PE_Ident inc, i]] + , tg_case1 = gen_var_case1, tg_case2 = gen_var_case2 + } + -> (transformed_generator,Yes (i,[]),0,ca) + Yes (i,size_expressions) + # transformed_generator + = { tg_expr = ([],[]) + , tg_lhs_arg = [] + , tg_case_end_expr = PE_Empty + , tg_case_end_pattern = PE_Empty + , tg_element = i + , tg_element_is_uselect=False + , tg_pattern = gen_pattern + , tg_rhs_continuation = [] + , tg_case1 = gen_var_case1, tg_case2 = gen_var_case2 + } + -> (transformed_generator,index_generator,0,ca) + # (i, ca) = prefixAndPositionToIdentExp "g_i" gen_position ca + # inc = get_predef_id PD_IncFun + # transformed_generator + = { tg_expr = ([],[from_exp]) + , tg_lhs_arg = [i] + , tg_case_end_expr = PE_Empty + , tg_case_end_pattern = PE_Empty + , tg_element = i + , tg_element_is_uselect=False + , tg_pattern = gen_pattern + , tg_rhs_continuation = [PE_List [PE_Ident inc, i]] + , tg_case1 = gen_var_case1, tg_case2 = gen_var_case2 + } + = (transformed_generator,index_generator,0,ca) transformGenerator {gen_kind, gen_expr, gen_pattern, gen_position} qual_filename index_generator ca # (list, ca) = prefixAndPositionToIdentExp "g_l" gen_position ca (hd, ca) = prefixAndPositionToIdentExp "g_h" gen_position ca @@ -759,8 +759,8 @@ transformArrayComprehension expr qualifiers ca (c_a_ident_exp, ca) = prefixAndPositionToIdentExp "c_a" qual_position ca create_array = get_predef_id PD__CreateArrayFun | same_index_for_update_and_array_generators qualifiers - # index_range = PE_Sequ (SQ_From (PE_Basic (BVI "0"))) - # index_generator = {gen_kind=IsListGenerator, gen_pattern=c_i_ident_exp, gen_expr=PE_Sequ (SQ_From (PE_Basic (BVI "0"))), gen_position=qual_position} + # index_range = PE_Sequ (SQ_From (PE_Basic (BVInt 0))) + # index_generator = {gen_kind=IsListGenerator, gen_pattern=c_i_ident_exp, gen_expr=PE_Sequ (SQ_From (PE_Basic (BVInt 0))), gen_position=qual_position} # update = PE_Update c_a_ident_exp [PS_Array c_i_ident_exp] expr | size_of_generators_can_be_computed_quickly qualifiers # {qual_generators,qual_filter,qual_position,qual_filename} = hd_qualifier @@ -778,7 +778,7 @@ transformArrayComprehension expr qualifiers ca # (length, ca) = computeSize qualifiers qual_position hd_qualifier.qual_filename ca # new_array = PE_List [PE_Ident create_array,length] # inc = get_predef_id PD_IncFun - new_array_and_index = [new_array,PE_Basic (BVI "0")] + new_array_and_index = [new_array,PE_Basic (BVInt 0)] update = [PE_Update c_a_ident_exp [PS_Array c_i_ident_exp] expr,PE_List [PE_Ident inc,c_i_ident_exp]] = transformUpdateComprehension new_array_and_index update [c_a_ident_exp,c_i_ident_exp] c_a_ident_exp qualifiers ca @@ -819,7 +819,7 @@ makeUpdateOrSizeComprehension transformed_qualifiers success identExprs result_e size_of_generator_can_be_computed_quickly {gen_pattern,gen_kind=IsArrayGenerator} = pattern_will_always_match gen_pattern -size_of_generator_can_be_computed_quickly {gen_pattern,gen_kind=IsListGenerator,gen_expr=PE_Sequ (SQ_FromTo (PE_Basic (BVI "0")) to_exp)} +size_of_generator_can_be_computed_quickly {gen_pattern,gen_kind=IsListGenerator,gen_expr=PE_Sequ (SQ_FromTo (PE_Basic (BVInt 0)) to_exp)} = pattern_will_always_match gen_pattern size_of_generator_can_be_computed_quickly {gen_pattern,gen_kind=IsListGenerator,gen_expr=PE_Sequ (SQ_From from_exp)} = pattern_will_always_match gen_pattern @@ -839,7 +839,7 @@ size_of_generators_can_be_computed_quickly _ computeSize :: [Qualifier] LineAndColumn FileName *CollectAdmin -> (!ParsedExpr,!*CollectAdmin) computeSize qualifiers qual_position qual_filename ca # (counter_ident_exp, ca) = prefixAndPositionToIdentExp "c_l_i" qual_position ca - (transformed_qualifiers,ca) = transformUpdateQualifiers [counter_ident_exp] [PE_Basic (BVI "0")] qualifiers ca + (transformed_qualifiers,ca) = transformUpdateQualifiers [counter_ident_exp] [PE_Basic (BVInt 0)] qualifiers ca inc = get_predef_id PD_IncFun success = insert_inc_in_inner_loop (last transformed_qualifiers).tq_continue with diff --git a/frontend/predef.dcl b/frontend/predef.dcl index 4a40acc..9b62ea0 100644 --- a/frontend/predef.dcl +++ b/frontend/predef.dcl @@ -4,6 +4,8 @@ import syntax, hashtable cPredefinedModuleIndex :== 1 +PD_StringTypeIndex :== 0 + :: PredefinedSymbols :== {# PredefinedSymbol} :: PredefinedSymbol = { diff --git a/frontend/predef.icl b/frontend/predef.icl index fdd16d8..8519287 100644 --- a/frontend/predef.icl +++ b/frontend/predef.icl @@ -4,6 +4,8 @@ import syntax, hashtable, type_io_common cPredefinedModuleIndex :== 1 +PD_StringTypeIndex :== 0 + :: PredefinedSymbols :== {# PredefinedSymbol} :: PredefinedSymbol = { diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl index 62cb971..cf2ffdd 100644 --- a/frontend/syntax.dcl +++ b/frontend/syntax.dcl @@ -653,11 +653,11 @@ cNonRecursiveAppl :== False :: FunctionInfo = FI_Empty | FI_Function !GeneratedFunction :: Producer = PR_Empty - | PR_Function !SymbIdent !Index + | PR_Function !SymbIdent !Int !Index | PR_Class !App ![(BoundVar, Type)] !Type - | PR_Constructor !SymbIdent ![Expression] - | PR_GeneratedFunction !SymbIdent !Index - | PR_Curried !SymbIdent + | PR_Constructor !SymbIdent !Int ![Expression] + | PR_GeneratedFunction !SymbIdent !Int !Index + | PR_Curried !SymbIdent !Int :: InstanceInfo = II_Empty | II_Node !{! Producer} !FunctionInfoPtr !InstanceInfo !InstanceInfo @@ -787,7 +787,6 @@ cNonRecursiveAppl :== False :: SymbIdent = { symb_name :: !Ident , symb_kind :: !SymbKind - , symb_arity :: !Int } :: ConsDef = @@ -949,7 +948,7 @@ cNonRecursiveAppl :== False | BT_File | BT_World | BT_String !Type /* the internal string type synonym only used to type string denotations */ -:: BasicValue = BVI !String | BVC !String | BVB !Bool | BVR !String | BVS !String +:: BasicValue = BVI !String | BVInt !Int |BVC !String | BVB !Bool | BVR !String | BVS !String :: TypeKind = KindVar !KindInfoPtr | KindConst | KindArrow ![TypeKind] | KindCycle @@ -1122,8 +1121,7 @@ cIsNotStrict :== False | Update !Expression ![Selection] Expression | RecordUpdate !(Global DefinedSymbol) !Expression ![Bind Expression (Global FieldSymbol)] | TupleSelect !DefinedSymbol !Int !Expression -// | Lambda .[FreeVar] !Expression - | BasicExpr !BasicValue !BasicType + | BasicExpr !BasicValue | WildCard | Conditional !Conditional @@ -1345,9 +1343,6 @@ MakeNewTypeSymbIdent name arity MakeTypeSymbIdent type_index name arity :== { newTypeSymbIdentCAF & type_name = name, type_arity = arity, type_index = type_index } -MakeSymbIdent name arity :== { symb_name = name, symb_kind = SK_Unknown, symb_arity = arity } -MakeConstant name :== MakeSymbIdent name 0 - ParsedSelectorToSelectorDef sd_type_index ps :== { sd_symb = ps.ps_selector_name, sd_field_nr = NoIndex, sd_pos = ps.ps_field_pos, sd_type_index = sd_type_index, sd_exi_vars = [], sd_type_ptr = nilPtr, sd_field = ps.ps_field_name, diff --git a/frontend/syntax.icl b/frontend/syntax.icl index 440f23f..1f943cb 100644 --- a/frontend/syntax.icl +++ b/frontend/syntax.icl @@ -638,11 +638,11 @@ cNotVarNumber :== -1 :: FunctionInfo = FI_Empty | FI_Function !GeneratedFunction :: Producer = PR_Empty - | PR_Function !SymbIdent !Index + | PR_Function !SymbIdent !Int !Index | PR_Class !App ![(BoundVar, Type)] !Type - | PR_Constructor !SymbIdent ![Expression] - | PR_GeneratedFunction !SymbIdent !Index - | PR_Curried !SymbIdent + | PR_Constructor !SymbIdent !Int ![Expression] + | PR_GeneratedFunction !SymbIdent !Int !Index + | PR_Curried !SymbIdent !Int :: InstanceInfo = II_Empty | II_Node !{! Producer} !FunctionInfoPtr !InstanceInfo !InstanceInfo @@ -765,7 +765,6 @@ cNotVarNumber :== -1 :: SymbIdent = { symb_name :: !Ident , symb_kind :: !SymbKind - , symb_arity :: !Int } :: ConsDef = @@ -929,9 +928,7 @@ cNotVarNumber :== -1 | BT_File | BT_World | BT_String !Type /* the internal string type synonym only used to type string denotations */ - -:: BasicValue = BVI !String | BVC !String | BVB !Bool | BVR !String | BVS !String - +:: BasicValue = BVI !String | BVInt !Int |BVC !String | BVB !Bool | BVR !String | BVS !String :: TypeKind = KindVar !KindInfoPtr | KindConst | KindArrow ![TypeKind] | KindCycle @@ -1109,8 +1106,7 @@ cIsNotStrict :== False | Update !Expression ![Selection] Expression | RecordUpdate !(Global DefinedSymbol) !Expression ![Bind Expression (Global FieldSymbol)] | TupleSelect !DefinedSymbol !Int !Expression -// | Lambda .[FreeVar] !Expression - | BasicExpr !BasicValue !BasicType + | BasicExpr !BasicValue | WildCard | Conditional !Conditional @@ -1300,16 +1296,14 @@ where instance needs_brackets Expression where - needs_brackets (App app) - = app.app_symb.symb_arity > 0 + needs_brackets (App {app_args}) + = not (isEmpty app_args) needs_brackets (_ @ _) = True needs_brackets (Let _) = True needs_brackets (Case _) = True -// needs_brackets (Lambda _ _) -// = True needs_brackets (Selection _ _ _) = True needs_brackets _ @@ -1547,6 +1541,7 @@ where instance <<< BasicValue where (<<<) file (BVI int) = file <<< int + (<<<) file (BVInt int) = file <<< int (<<<) file (BVC char) = file <<< char (<<<) file (BVB bool) = file <<< bool (<<<) file (BVR real) = file <<< real @@ -1578,7 +1573,7 @@ where (<<<) file (Case {case_expr,case_guards,case_default= Yes def_expr}) //= file <<< "case " <<< case_expr <<< " of\n" <<< case_guards <<< "\n\t->" <<< def_expr = file <<< "case " <<< case_expr <<< " of" <<< case_guards <<< "\n\t->" <<< def_expr - (<<<) file (BasicExpr basic_value basic_type) = file <<< basic_value + (<<<) file (BasicExpr basic_value) = file <<< basic_value (<<<) file (Conditional {if_cond,if_then,if_else}) = else_part (file <<< "IF " <<< if_cond <<< "\nTHEN\n" <<< if_then) if_else where @@ -2058,7 +2053,7 @@ where = file <<< "update" show_expression file (TupleSelect {ds_arity} elem_nr expr) = file <<< "argument " <<< (elem_nr + 1) <<< " of " <<< ds_arity <<< "-tuple" - show_expression file (BasicExpr bv _) + show_expression file (BasicExpr bv) = file <<< bv show_expression file (MatchExpr _ _ expr) = file <<< "match expression" @@ -2213,9 +2208,6 @@ MakeTypeSymbIdentMacro type_index name arity :== { type_name = name, type_arity = arity, type_index = type_index, type_prop = { tsp_sign = BottomSignClass, tsp_propagation = NoPropClass, tsp_coercible = True }} -MakeSymbIdent name arity :== { symb_name = name, symb_kind = SK_Unknown, symb_arity = arity } -MakeConstant name :== MakeSymbIdent name 0 - ParsedSelectorToSelectorDef sd_type_index ps :== { sd_symb = ps.ps_selector_name, sd_field_nr = NoIndex, sd_pos = ps.ps_field_pos, sd_type_index = sd_type_index, sd_exi_vars = [], sd_type_ptr = nilPtr, sd_field = ps.ps_field_name, diff --git a/frontend/trans.icl b/frontend/trans.icl index 62f613c..ab787e9 100644 --- a/frontend/trans.icl +++ b/frontend/trans.icl @@ -264,7 +264,7 @@ instance consumerRequirements Expression where consumerRequirements (Case case_expr) common_defs ai = consumerRequirements case_expr common_defs ai - consumerRequirements (BasicExpr _ _) _ ai + consumerRequirements (BasicExpr _) _ ai = (cPassive, False, ai) consumerRequirements (MatchExpr _ _ expr) common_defs ai = consumerRequirements expr common_defs ai @@ -313,14 +313,14 @@ where = ai instance consumerRequirements App where - consumerRequirements {app_symb={symb_kind = SK_Function {glob_module,glob_object}, symb_arity, symb_name}, app_args} common_defs=:(ConsumerAnalysisRO {main_dcl_module_n,stdStrictLists_module_n,imported_funs}) ai=:{ai_cons_class/*,ai_main_dcl_module_n*/} + consumerRequirements {app_symb={symb_kind = SK_Function {glob_module,glob_object}, symb_name}, app_args} common_defs=:(ConsumerAnalysisRO {main_dcl_module_n,stdStrictLists_module_n,imported_funs}) ai=:{ai_cons_class/*,ai_main_dcl_module_n*/} | glob_module == main_dcl_module_n//ai_main_dcl_module_n | glob_object < size ai_cons_class #! fun_class = ai_cons_class.[glob_object] = reqs_of_args fun_class.cc_args app_args cPassive common_defs ai = consumerRequirements app_args common_defs ai - | glob_module==stdStrictLists_module_n && symb_arity>0 && is_nil_cons_or_decons_of_UList_or_UTSList glob_object glob_module imported_funs + | glob_module==stdStrictLists_module_n && (not (isEmpty app_args)) && is_nil_cons_or_decons_of_UList_or_UTSList glob_object glob_module imported_funs // && trace_tn ("consumerRequirements "+++symb_name.id_name+++" "+++toString imported_funs.[glob_module].[glob_object].ft_type.st_arity) # [app_arg:app_args]=app_args; # (cc, _, ai) = consumerRequirements app_arg common_defs ai @@ -329,7 +329,7 @@ instance consumerRequirements App where = consumerRequirements app_args common_defs ai = consumerRequirements app_args common_defs ai - consumerRequirements {app_symb={symb_kind = SK_LocalMacroFunction glob_object, symb_arity, symb_name}, app_args} common_defs=:(ConsumerAnalysisRO {main_dcl_module_n}) ai=:{ai_cons_class/*,ai_main_dcl_module_n*/} + consumerRequirements {app_symb={symb_kind = SK_LocalMacroFunction glob_object, symb_name}, app_args} common_defs=:(ConsumerAnalysisRO {main_dcl_module_n}) ai=:{ai_cons_class/*,ai_main_dcl_module_n*/} | glob_object < size ai_cons_class #! fun_class = ai_cons_class.[glob_object] = reqs_of_args fun_class.cc_args app_args cPassive common_defs ai @@ -365,7 +365,7 @@ instance consumerRequirements Case where -> ai _ -> ai # ai = case case_guards of - OverloadedListPatterns (OverloadedList _ _ _ _) decons_expr=:(App {app_symb={symb_arity=1,symb_kind=SK_Function _},app_args=[app_arg]}) patterns + OverloadedListPatterns (OverloadedList _ _ _ _) decons_expr=:(App {app_symb={symb_kind=SK_Function _},app_args=[app_arg]}) patterns // decons_expr will be optimized to a decons_u Selector in transform # (cc, _, ai) = consumerRequirements app_arg common_defs ai # ai_class_subst = unifyClassifications cActive cc ai.ai_class_subst @@ -883,7 +883,7 @@ transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_inf (app_args2, ti) = transform app_args1 { ro & ro_root_case_mode = NotRootCase } ti -> (App {app_symb=app_symb, app_args=app_args2, app_info_ptr=nilPtr}, ti) No -> skip_over this_case ro ti - BasicExpr basic_value _ + BasicExpr basic_value | not is_active -> skip_over this_case ro ti // XXX currently only active cases are matched at runtime (multimatch problem) # basicPatterns = getBasicPatterns case_guards @@ -1015,7 +1015,7 @@ transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_inf = match_and_instantiate linearities cons_index app_args guards case_default ro ti where in_normal_form (Var _) = True - in_normal_form (BasicExpr _ _) = True + in_normal_form (BasicExpr _) = True in_normal_form _ = False filterWith [True:t2] [h1:t1] @@ -1097,7 +1097,7 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti fun_ident = { id_name = ro.ro_fun_root.symb_name.id_name+++"_case", id_info = nilPtr } fun_symb - = { symb_name = fun_ident, symb_kind=SK_GeneratedFunction fun_info_ptr undeff, symb_arity = length all_args } + = { symb_name = fun_ident, symb_kind=SK_GeneratedFunction fun_info_ptr undeff } new_ro = { ro & ro_root_case_mode = RootCaseOfZombie , ro_fun_case = fun_symb, ro_fun_args = all_args } ti @@ -1351,9 +1351,9 @@ where = Smaller = Greater where - compare_constructor_arguments (PR_Function _ index1) (PR_Function _ index2) + compare_constructor_arguments (PR_Function _ _ index1) (PR_Function _ _ index2) = index1 =< index2 - compare_constructor_arguments (PR_GeneratedFunction _ index1) (PR_GeneratedFunction _ index2) + compare_constructor_arguments (PR_GeneratedFunction _ _ index1) (PR_GeneratedFunction _ _ index2) = index1 =< index2 compare_constructor_arguments (PR_Class app1 lifted_vars_with_types1 t1) (PR_Class app2 lifted_vars_with_types2 t2) @@ -1362,11 +1362,11 @@ where | cmp<>Equal = cmp = compare_types lifted_vars_with_types1 lifted_vars_with_types2 - compare_constructor_arguments (PR_Curried symb_ident1) (PR_Curried symb_ident2) + compare_constructor_arguments (PR_Curried symb_ident1 _) (PR_Curried symb_ident2 _) = symb_ident1 =< symb_ident2 compare_constructor_arguments PR_Empty PR_Empty = Equal - compare_constructor_arguments (PR_Constructor symb_ident1 _) (PR_Constructor symb_ident2 _) + compare_constructor_arguments (PR_Constructor symb_ident1 _ _) (PR_Constructor symb_ident2 _ _) = symb_ident1 =< symb_ident2 compare_types [(_, type1):types1] [(_, type2):types2] @@ -1622,7 +1622,7 @@ generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi (tb_rhs, {us_var_heap,us_symbol_heap,us_opt_type_heaps=Yes ti_type_heaps, us_cleanup_info}) = unfold tb_rhs ui us // | False -!-> ("unfolded:", tb_rhs) = undef - # ro_fun= { symb_name = fd.fun_symb, symb_kind = SK_GeneratedFunction fun_def_ptr ti_next_fun_nr, symb_arity = fun_arity} + # ro_fun= { symb_name = fd.fun_symb, symb_kind = SK_GeneratedFunction fun_def_ptr ti_next_fun_nr } # ro = { ro & ro_root_case_mode = case tb_rhs of Case _ -> RootCase @@ -1760,14 +1760,14 @@ where (vars, arg_types, next_attr_nr, new_linear_bits, new_cons_args, uniqueness_requirements, subst, let_bindings, type_heaps=:{th_vars, th_attrs}, symbol_heap, fun_defs, fun_heap, var_heap, ti_cons_args) - # symbol + # (symbol,symbol_arity) = get_producer_symbol producer curried = is_curried producer #! size_fun_defs = size fun_defs # ({cc_args, cc_linear_bits}, fun_heap, ti_cons_args) - = calc_cons_args curried symbol ti_cons_args linear_bit size_fun_defs fun_heap + = calc_cons_args curried symbol symbol_arity ti_cons_args linear_bit size_fun_defs fun_heap (arg_type, arg_types) = arg_types![prod_index] (next_attr_nr, th_attrs) @@ -1776,7 +1776,7 @@ where (_, (st_args, st_result), type_heaps) = substitute (st_args, st_result) { type_heaps & th_vars = th_vars, th_attrs = th_attrs } nr_of_applied_args - = symbol.symb_arity + = symbol_arity application_type = build_application_type st_arity (length st_context) st_result st_args nr_of_applied_args type_input @@ -1795,12 +1795,12 @@ where ur_attr_ineqs = attr_inequalities } (opt_body, var_names, fun_defs, fun_heap) = case producer of - (PR_Constructor {symb_arity, symb_kind=SK_Constructor {glob_module}} _) - -> (NoBody, repeatn symb_arity { id_name = "_x", id_info = nilPtr }, fun_defs, fun_heap) - (PR_Curried {symb_arity, symb_kind=SK_Function {glob_module}}) + (PR_Constructor {symb_kind=SK_Constructor {glob_module}} arity _) + -> (NoBody, repeatn arity { id_name = "_x", id_info = nilPtr }, fun_defs, fun_heap) + (PR_Curried {symb_kind=SK_Function {glob_module}} arity) | glob_module <> ro.ro_main_dcl_module_n // we do not have good names for the formal variables of that function: invent some - -> (NoBody, repeatn symb_arity { id_name = "_x", id_info = nilPtr }, fun_defs, fun_heap) + -> (NoBody, repeatn arity { id_name = "_x", id_info = nilPtr }, fun_defs, fun_heap) // GOTO next alternative _ # ({fun_body=fun_body=:TransformedBody tb}, fun_defs, fun_heap) @@ -1810,9 +1810,9 @@ where = build_var_args (reverse var_names) vars [] var_heap (expr_to_unfold, var_heap) = case producer of - (PR_Constructor symb expr) + (PR_Constructor symb _ expr) -> (VI_Expression (App { app_symb = symbol, app_args = act_vars, app_info_ptr = nilPtr }), var_heap) - (PR_Curried _) + (PR_Curried _ _) -> (VI_Expression (App { app_symb = symbol, app_args = act_vars, app_info_ptr = nilPtr }), var_heap) _ // function or generated function # (TransformedBody tb) = opt_body @@ -1850,7 +1850,7 @@ where , ti_cons_args ) where - calc_cons_args curried {symb_kind, symb_arity} ti_cons_args linear_bit size_fun_defs fun_heap + calc_cons_args curried {symb_kind} symbol_arity ti_cons_args linear_bit size_fun_defs fun_heap # (cons_size, ti_cons_args) = usize ti_cons_args # (opt_cons_classes, fun_heap, ti_cons_args) = case symb_kind of @@ -1876,14 +1876,14 @@ where -> (No, fun_heap, ti_cons_args) = case opt_cons_classes of Yes cons_classes - -> ({ cc_size = symb_arity, cc_args = take symb_arity cons_classes.cc_args, - cc_linear_bits = if curried (repeatn symb_arity linear_bit) - (take symb_arity cons_classes.cc_linear_bits), + -> ({ cc_size = symbol_arity, cc_args = take symbol_arity cons_classes.cc_args, + cc_linear_bits = if curried (repeatn symbol_arity linear_bit) + (take symbol_arity cons_classes.cc_linear_bits), cc_producer = False} , fun_heap, ti_cons_args) No - -> ({cc_size = symb_arity, cc_args = repeatn symb_arity cPassive, - cc_linear_bits = repeatn symb_arity linear_bit, + -> ({cc_size = symbol_arity, cc_args = repeatn symbol_arity cPassive, + cc_linear_bits = repeatn symbol_arity linear_bit, cc_producer = False}, fun_heap, ti_cons_args) @@ -1899,7 +1899,7 @@ where # (FI_Function {gf_fun_def}, fun_heap) = readPtr fun_ptr fun_heap = (gf_fun_def, fun_defs, fun_heap) - is_curried (PR_Curried _) = True + is_curried (PR_Curried _ _) = True is_curried _ = False build_application_type st_arity nr_context_args st_result st_args nr_of_applied_args @@ -1991,7 +1991,7 @@ where PR_Class _ _ class_type -> ([No:type_accu], ti_fun_defs, ti_fun_heap) producer - # symbol = get_producer_symbol producer + # (symbol,_) = get_producer_symbol producer (symbol_type, ti_fun_defs, ti_fun_heap) = get_producer_type symbol ro ti_fun_defs ti_fun_heap -> ([Yes symbol_type:type_accu], ti_fun_defs, ti_fun_heap) @@ -2023,14 +2023,14 @@ where collect_unencountered_cons_var _ _ state = state - get_producer_symbol (PR_Curried symbol) - = symbol - get_producer_symbol (PR_Function symbol _) - = symbol - get_producer_symbol (PR_GeneratedFunction symbol _) - = symbol - get_producer_symbol (PR_Constructor symbol _) - = symbol + get_producer_symbol (PR_Curried symbol arity) + = (symbol,arity) + get_producer_symbol (PR_Function symbol arity _) + = (symbol,arity) + get_producer_symbol (PR_GeneratedFunction symbol arity _) + = (symbol,arity) + get_producer_symbol (PR_Constructor symbol arity _) + = (symbol,arity) replace_integers_in_substitution replace_input i (subst, used) # (subst_i, subst) @@ -2106,25 +2106,25 @@ where = (current_max, cons_args, fun_defs, fun_heap) max_group_index_of_producer (PR_Class {app_args} _ _) current_max fun_defs fun_heap cons_args = foldSt (foldrExprSt max_group_index_of_member) app_args (current_max, cons_args, fun_defs, fun_heap) - max_group_index_of_producer (PR_Curried {symb_kind=SK_Function {glob_object=fun_index, glob_module}}) current_max fun_defs fun_heap cons_args + max_group_index_of_producer (PR_Curried {symb_kind=SK_Function {glob_object=fun_index, glob_module}} _) current_max fun_defs fun_heap cons_args | glob_module<>ro_main_dcl_module_n = (current_max, cons_args, fun_defs, fun_heap) # (current_max, fun_defs) = max_group_index_of_fun_with_fun_index fun_index current_max fun_defs = (current_max, cons_args, fun_defs, fun_heap) - max_group_index_of_producer (PR_Curried {symb_kind=SK_LocalMacroFunction fun_index}) current_max fun_defs fun_heap cons_args + max_group_index_of_producer (PR_Curried {symb_kind=SK_LocalMacroFunction fun_index} _) current_max fun_defs fun_heap cons_args # (current_max, fun_defs) = max_group_index_of_fun_with_fun_index fun_index current_max fun_defs = (current_max, cons_args, fun_defs, fun_heap) - max_group_index_of_producer (PR_Curried { symb_kind = SK_GeneratedFunction fun_ptr fun_index}) current_max fun_defs fun_heap cons_args + max_group_index_of_producer (PR_Curried { symb_kind = SK_GeneratedFunction fun_ptr fun_index} _) current_max fun_defs fun_heap cons_args # (current_max, fun_defs, fun_heap) = max_group_index_of_fun_with_fun_index_and_ptr fun_ptr fun_index current_max fun_defs fun_heap = (current_max, cons_args, fun_defs, fun_heap) - max_group_index_of_producer (PR_Function _ fun_index) current_max fun_defs fun_heap cons_args + max_group_index_of_producer (PR_Function _ _ fun_index) current_max fun_defs fun_heap cons_args # (current_max, fun_defs) = max_group_index_of_fun_with_fun_index fun_index current_max fun_defs = (current_max, cons_args, fun_defs, fun_heap) - max_group_index_of_producer (PR_GeneratedFunction { symb_kind = SK_GeneratedFunction fun_ptr fun_index} _) + max_group_index_of_producer (PR_GeneratedFunction { symb_kind = SK_GeneratedFunction fun_ptr fun_index} _ _) current_max fun_defs fun_heap cons_args # (current_max, fun_defs, fun_heap) = max_group_index_of_fun_with_fun_index_and_ptr fun_ptr fun_index current_max fun_defs fun_heap = (current_max, cons_args, fun_defs, fun_heap) - max_group_index_of_producer (PR_Constructor symb args) current_max fun_defs fun_heap cons_args + max_group_index_of_producer (PR_Constructor symb _ args) current_max fun_defs fun_heap cons_args = (current_max, cons_args, fun_defs, fun_heap) // DvA: not a clue what we're trying here... max_group_index_of_producer prod current_max fun_defs fun_heap cons_args = abort ("trans.icl: max_group_index_of_producer" ---> prod) @@ -2150,7 +2150,7 @@ where = (max fi_group_index current_max, cons_args, fun_defs, fun_heap) = (current_max, cons_args, fun_defs, fun_heap) max_group_index_of_member - (App {app_symb = {symb_kind = SK_GeneratedFunction fun_ptr _ }}) + (App {app_symb = {symb_kind = SK_GeneratedFunction fun_ptr _}}) (current_max, cons_args, fun_defs, fun_heap) # (FI_Function {gf_fun_def={fun_info = {fi_group_index}}}, fun_heap) = readPtr fun_ptr fun_heap = (max fi_group_index current_max, cons_args, fun_defs, fun_heap) @@ -2251,7 +2251,7 @@ allocate_fresh_type_var i (accu, th_vars) = ([tv:accu], th_vars) transformFunctionApplication fun_def instances cc=:{cc_size, cc_args, cc_linear_bits} app=:{app_symb,app_args} extra_args ro ti - # (app_symb, app_args, extra_args) = complete_application app_symb fun_def.fun_arity app_args extra_args + # (app_args, extra_args) = complete_application fun_def.fun_arity app_args extra_args | False -!-> ("transformFunctionApplication",app_symb,app_args) = undef | cc_size > 0 && not_expanding_consumer | False-!->("determineProducers",(app_symb.symb_name, cc_linear_bits,cc_args,app_args)) @@ -2265,12 +2265,12 @@ transformFunctionApplication fun_def instances cc=:{cc_size, cc_args, cc_linear_ | is_new # ti = update_instance_info app_symb.symb_kind instances { ti & ti_fun_heap = ti_fun_heap } # (fun_index, fun_arity, ti) = generateFunction fun_def cc producers fun_def_ptr ro ti - app_symb = { app_symb & symb_kind = SK_GeneratedFunction fun_def_ptr fun_index, symb_arity = length new_args} - # (app_symb, app_args, extra_args) = complete_application app_symb fun_arity new_args extra_args + app_symb = { app_symb & symb_kind = SK_GeneratedFunction fun_def_ptr fun_index } + # (app_args, extra_args) = complete_application fun_arity new_args extra_args = transformApplication { app & app_symb = app_symb, app_args = app_args } extra_args ro ti # (FI_Function {gf_fun_index, gf_fun_def}, ti_fun_heap) = readPtr fun_def_ptr ti_fun_heap - app_symb = { app_symb & symb_kind = SK_GeneratedFunction fun_def_ptr gf_fun_index, symb_arity = length new_args} - (app_symb, app_args, extra_args) = complete_application app_symb gf_fun_def.fun_arity new_args extra_args + app_symb = { app_symb & symb_kind = SK_GeneratedFunction fun_def_ptr gf_fun_index } + (app_args, extra_args) = complete_application gf_fun_def.fun_arity new_args extra_args # ti = {ti & ti_fun_heap = ti_fun_heap } = transformApplication { app & app_symb = app_symb, app_args = app_args } extra_args ro ti = (build_application { app & app_symb = app_symb, app_args = app_args } extra_args, ti) @@ -2290,11 +2290,11 @@ where # (FI_Function fun_info, ti_fun_heap) = readPtr fun_def_ptr ti_fun_heap = { ti & ti_fun_heap = ti_fun_heap <:= (fun_def_ptr, FI_Function { fun_info & gf_instance_info = instances })} - complete_application symb form_arity args [] - = (symb, args, []) - complete_application symb=:{symb_arity} form_arity args extra_args - # arity_diff = min (form_arity - symb_arity) (length extra_args) - = ({ symb & symb_arity = symb_arity + arity_diff }, args ++ take arity_diff extra_args, drop arity_diff extra_args) + complete_application form_arity args [] + = (args, []) + complete_application form_arity args extra_args + # arity_diff = min (form_arity - length args) (length extra_args) + = (args ++ take arity_diff extra_args, drop arity_diff extra_args) build_application app [] = App app @@ -2309,7 +2309,7 @@ is_nil_cons_or_decons_of_UList_or_UTSList glob_object glob_module imported_funs :== not (isEmpty imported_funs.[glob_module].[glob_object].ft_type.st_context); transformApplication :: !App ![Expression] !ReadOnlyTI !*TransformInfo -> *(!Expression,!*TransformInfo) -transformApplication app=:{app_symb=symb=:{symb_kind,symb_arity}, app_args} extra_args +transformApplication app=:{app_symb=symb=:{symb_kind}, app_args} extra_args ro ti=:{ti_cons_args,ti_instances,ti_fun_defs} | is_SK_Function_or_SK_LocalMacroFunction symb_kind // otherwise GOTO next alternative # { glob_module, glob_object } @@ -2326,9 +2326,9 @@ transformApplication app=:{app_symb=symb=:{symb_kind,symb_arity}, app_args} extr // It seems as if we have an array function | isEmpty extra_args = (App app, ti) - = (App { app & app_symb = { symb & symb_arity = symb_arity + length extra_args}, app_args = app_args ++ extra_args}, ti) + = (App { app & app_args = app_args ++ extra_args}, ti) - | glob_module==ro.ro_stdStrictLists_module_n && is_cons_or_decons_of_UList_or_UTSList glob_object glob_module ro.ro_imported_funs && symb_arity>0 + | glob_module==ro.ro_stdStrictLists_module_n && is_cons_or_decons_of_UList_or_UTSList glob_object glob_module ro.ro_imported_funs && (not (isEmpty app_args)) // && trace_tn ("transformApplication "+++toString symb.symb_name) # {ft_type} = ro.ro_imported_funs.[glob_module].[glob_object] // type of cons instance of instance List [#] a | U(TS)List a # [{tc_class={glob_module,glob_object={ds_index}}}:_] = ft_type.st_context @@ -2351,12 +2351,11 @@ transformApplication app=:{app_symb=symb=:{symb_kind,symb_arity}, app_args} extr = (App app, ti) # {ft_arity,ft_type} = ro.ro_imported_funs.[glob_module].[glob_object] form_arity = ft_arity + length ft_type.st_context - ar_diff = form_arity - symb_arity + ar_diff = form_arity - length app_args nr_of_extra_args = length extra_args | nr_of_extra_args <= ar_diff - = (App {app & app_args = app_args ++ extra_args, app_symb = { symb & symb_arity = symb_arity + nr_of_extra_args }}, ti) - = (App {app & app_args = app_args ++ take ar_diff extra_args, app_symb = { symb & symb_arity = symb_arity + ar_diff }} @ - drop ar_diff extra_args, ti) + = (App {app & app_args = app_args ++ extra_args }, ti) + = (App {app & app_args = app_args ++ take ar_diff extra_args } @ drop ar_diff extra_args, ti) where find_member_n i member_string a | i<size a @@ -2424,9 +2423,6 @@ where = (producers, [arg : new_args], ti) // XXX check for linear_bit also in case of a constructor ? -determineProducer _ _ app=:{app_symb = {symb_arity}, app_args} _ new_args prod_index producers _ ti - | symb_arity<>length app_args - = abort "sanity check 98765 failed in module trans" determineProducer _ _ app=:{app_symb = symb=:{symb_kind = SK_Constructor _}, app_args} (EI_DictionaryType type) new_args prod_index producers _ ti # (app_args, (new_vars_and_types, free_vars, ti_var_heap)) = renewVariables app_args ti.ti_var_heap @@ -2440,19 +2436,19 @@ determineProducer _ linear_bit app=:{app_symb = symb=:{symb_kind = SK_Constructo | False -!-> ("ProduceXcc",symb_name) = undef | SwitchConstructorFusion (ro.ro_transform_fusion && linear_bit) False - # producers = {producers & [prod_index] = PR_Constructor symb app_args } + # producers = {producers & [prod_index] = PR_Constructor symb (length app_args) app_args } = (producers, app_args ++ new_args, ti) = ( producers, [App app : new_args ], ti) -determineProducer is_applied_to_macro_fun linear_bit app=:{app_symb = symb=:{ symb_kind = SK_GeneratedFunction fun_ptr fun_index, symb_arity}, app_args} _ +determineProducer is_applied_to_macro_fun linear_bit app=:{app_symb = symb=:{ symb_kind = SK_GeneratedFunction fun_ptr fun_index}, app_args} _ new_args prod_index producers ro ti # (FI_Function {gf_cons_args={cc_producer},gf_fun_def={fun_body, fun_arity, fun_type=Yes symbol_type}}, ti_fun_heap) = readPtr fun_ptr ti.ti_fun_heap ti = { ti & ti_fun_heap=ti_fun_heap } - | symb_arity<>fun_arity + | length app_args<>fun_arity | is_applied_to_macro_fun - = ({ producers & [prod_index] = PR_Curried symb}, app_args ++ new_args, ti) + = ({ producers & [prod_index] = PR_Curried symb (length app_args)}, app_args ++ new_args, ti) -!-> ("Produce1cc_macro",symb.symb_name) | SwitchCurriedFusion ro.ro_transform_fusion False - = ({ producers & [prod_index] = PR_Curried symb}, app_args ++ new_args, ti) + = ({ producers & [prod_index] = PR_Curried symb (length app_args)}, app_args ++ new_args, ti) -!-> ("Produce1cc_curried",symb.symb_name) = (producers, [App app : new_args ], ti) # is_good_producer @@ -2462,10 +2458,10 @@ determineProducer is_applied_to_macro_fun linear_bit app=:{app_symb = symb=:{ sy (TransformedBody {tb_rhs}) -> SwitchGeneratedFusion (ro.ro_transform_fusion && linear_bit && is_sexy_body tb_rhs) False | cc_producer && is_good_producer - = ({ producers & [prod_index] = (PR_GeneratedFunction symb fun_index)}, app_args ++ new_args, ti) + = ({ producers & [prod_index] = (PR_GeneratedFunction symb (length app_args) fun_index)}, app_args ++ new_args, ti) -!-> ("Produce1cc",symb.symb_name) = (producers, [App app : new_args ], ti) -determineProducer is_applied_to_macro_fun linear_bit app=:{app_symb = symb=:{symb_kind, symb_arity}, app_args} _ +determineProducer is_applied_to_macro_fun linear_bit app=:{app_symb = symb=:{symb_kind}, app_args} _ new_args prod_index producers ro ti | is_SK_Function_or_SK_LocalMacroFunction symb_kind # { glob_module, glob_object } @@ -2473,12 +2469,12 @@ determineProducer is_applied_to_macro_fun linear_bit app=:{app_symb = symb=:{sym SK_Function global_index -> global_index SK_LocalMacroFunction index -> { glob_module = ro.ro_main_dcl_module_n, glob_object = index } # (fun_arity, ti) = get_fun_arity glob_module glob_object ro ti - | symb_arity<>fun_arity + | length app_args<>fun_arity | is_applied_to_macro_fun - = ({ producers & [prod_index] = PR_Curried symb}, app_args ++ new_args, ti) + = ({ producers & [prod_index] = PR_Curried symb (length app_args)}, app_args ++ new_args, ti) -!-> ("Produce2cc_macro",symb.symb_name) | SwitchCurriedFusion ro.ro_transform_fusion False - = ({ producers & [prod_index] = PR_Curried symb}, app_args ++ new_args, ti) + = ({ producers & [prod_index] = PR_Curried symb (length app_args)}, app_args ++ new_args, ti) -!-> ("Produce2cc_curried",symb.symb_name) = (producers, [App app : new_args ], ti) #! max_index = size ti.ti_cons_args @@ -2491,7 +2487,7 @@ determineProducer is_applied_to_macro_fun linear_bit app=:{app_symb = symb=:{sym is_good_producer = SwitchFunctionFusion (ro.ro_transform_fusion && linear_bit && is_sexy_body tb_rhs) False {cc_producer} = ti.ti_cons_args.[glob_object] | is_good_producer && cc_producer - = ({ producers & [prod_index] = (PR_Function symb glob_object)}, app_args ++ new_args, ti) + = ({ producers & [prod_index] = (PR_Function symb (length app_args) glob_object)}, app_args ++ new_args, ti) -!-> ("Produce2cc",symb.symb_name) = (producers, [App app : new_args ], ti) = (producers, [App app : new_args ], ti) @@ -2678,8 +2674,8 @@ transformGroups cleanup_info main_dcl_module_n stdStrictLists_module_n groups fu (fun_rhs, ti) = transform tb.tb_rhs ro { ti & ti_fun_defs = ti_fun_defs, ti_var_heap = ti_var_heap } = { ti & ti_fun_defs = {ti.ti_fun_defs & [fun] = { fun_def & fun_body = TransformedBody { tb & tb_rhs = fun_rhs }}}} where - fun_def_to_symb_ident fun_index {fun_symb,fun_arity} - = { symb_name=fun_symb, symb_kind=SK_Function {glob_object=fun_index, glob_module=main_dcl_module_n } , symb_arity=fun_arity } + fun_def_to_symb_ident fun_index {fun_symb} + = { symb_name=fun_symb, symb_kind=SK_Function {glob_object=fun_index, glob_module=main_dcl_module_n } } get_root_case_mode {tb_rhs=Case _} = RootCase get_root_case_mode _ = NotRootCase @@ -3071,13 +3067,13 @@ where // XXX instance <<< Producer where - (<<<) file (PR_Function symbol index) + (<<<) file (PR_Function symbol _ index) = file <<< "(F)" <<< symbol.symb_name - (<<<) file (PR_GeneratedFunction symbol index) + (<<<) file (PR_GeneratedFunction symbol _ index) = file <<< "(G)" <<< symbol.symb_name <<< index (<<<) file PR_Empty = file <<< 'E' (<<<) file (PR_Class app vars type) = file <<< "(Class(" <<< App app<<<","<<< type <<< "))" - (<<<) file (PR_Curried {symb_name, symb_kind}) = file <<< "(Curried)" <<< symb_name <<< symb_kind + (<<<) file (PR_Curried {symb_name, symb_kind} _) = file <<< "(Curried)" <<< symb_name <<< symb_kind (<<<) file _ = file instance <<< SymbKind @@ -3276,7 +3272,7 @@ instance producerRequirements Expression where = (safe,prs) producerRequirements (TupleSelect _ _ expr) prs = producerRequirements expr prs - producerRequirements (BasicExpr _ _) prs + producerRequirements (BasicExpr _) prs = (True,prs) producerRequirements (AnyCodeExpr _ _ _) prs = (False,prs) @@ -3335,7 +3331,7 @@ instance producerRequirements BasicPattern where = producerRequirements bp_expr prs // compare with 'get_fun_def_and_cons_args' -retrieve_consumer_args si=:{symb_kind, symb_arity} prs=:{prs_cons_args, prs_main_dcl_module_n} +retrieve_consumer_args si=:{symb_kind} prs=:{prs_cons_args, prs_main_dcl_module_n} # (prs_size, prs_cons_args) = usize prs_cons_args prs = {prs & prs_cons_args = prs_cons_args} = case symb_kind of diff --git a/frontend/transform.icl b/frontend/transform.icl index 5f01351..f2345b8 100644 --- a/frontend/transform.icl +++ b/frontend/transform.icl @@ -96,7 +96,7 @@ where instance lift App where - lift app=:{app_symb = app_symbol=:{symb_arity,symb_kind = SK_Function {glob_object,glob_module}}, app_args} ls + lift app=:{app_symb = app_symbol=:{symb_kind = SK_Function {glob_object,glob_module}}, app_args} ls | glob_module == ls.ls_x.LiftStateX.x_main_dcl_module_n # (fun_def,ls) = ls!ls_x.x_fun_defs.[glob_object] = lift_function_app app fun_def.fun_info.fi_free_vars ls @@ -112,13 +112,13 @@ where # (app_args, ls) = lift app_args ls = ({ app & app_args = app_args }, ls) -lift_function_app app=:{app_symb=app_symbol=:{symb_arity},app_args} [] ls +lift_function_app app=:{app_symb=app_symbol,app_args} [] ls # (app_args, ls) = lift app_args ls = ({ app & app_args = app_args }, ls) -lift_function_app app=:{app_symb=app_symbol=:{symb_arity},app_args} fi_free_vars ls +lift_function_app app=:{app_args} fi_free_vars ls # (app_args, ls) = lift app_args ls # (app_args, ls_var_heap, ls_expr_heap) = add_free_variables_in_app fi_free_vars app_args ls.ls_var_heap ls.ls_expr_heap - # app = { app & app_args = app_args, app_symb = { app_symbol & symb_arity = symb_arity + length fi_free_vars }} + # app = { app & app_args = app_args } = (app, { ls & ls_var_heap = ls_var_heap, ls_expr_heap = ls_expr_heap }) where add_free_variables_in_app :: ![FreeVar] ![Expression] !*VarHeap !*ExpressionHeap -> (![Expression],!*VarHeap,!*ExpressionHeap) @@ -1187,15 +1187,15 @@ where has_no_curried_macro_CheckedAlternative [] = True - has_no_curried_macro_Expression (App app=:{app_symb={symb_arity, symb_kind = SK_DclMacro {glob_object,glob_module}}, app_args}) - | macro_defs.[glob_module,glob_object].fun_arity<>symb_arity + has_no_curried_macro_Expression (App {app_symb={symb_kind = SK_DclMacro {glob_object,glob_module}}, app_args}) + | macro_defs.[glob_module,glob_object].fun_arity<>length app_args = False; = has_no_curried_macro_Expressions app_args - has_no_curried_macro_Expression (App app=:{app_symb={symb_arity, symb_kind = SK_IclMacro glob_object}, app_args}) - | fun_defs.[glob_object].fun_arity<>symb_arity + has_no_curried_macro_Expression (App {app_symb={symb_kind = SK_IclMacro glob_object}, app_args}) + | fun_defs.[glob_object].fun_arity<>length app_args = False; = has_no_curried_macro_Expressions app_args - has_no_curried_macro_Expression (App app=:{app_args}) + has_no_curried_macro_Expression (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 @@ -1558,12 +1558,12 @@ class expand a :: !a !*ExpandInfo -> (!a, !*ExpandInfo) instance expand Expression where - expand (App app=:{app_symb = symb=:{symb_arity, symb_kind = SK_DclMacro {glob_object,glob_module}}, app_args}) ei + expand (App app=:{app_symb = symb=:{symb_kind = SK_DclMacro {glob_object,glob_module}}, app_args}) ei # (app_args, (calls, es)) = expand app_args ei # (macro, es) = es!es_macro_defs.[glob_module,glob_object] #! macro_group_index=macro.fun_info.fi_group_index # es = {es & es_macro_defs.[glob_module,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 == length app_args = unfoldMacro macro app_args True (calls, es) # macro = {macro & fun_info.fi_group_index=if (macro_group_index<NoIndex) (-2-macro_group_index) macro_group_index} @@ -1593,12 +1593,12 @@ where = (app, (calls, { es & es_symbol_table = es_symbol_table })) = (app, (calls, { es & es_symbol_table = es_symbol_table })) */ - expand (App app=:{app_symb = symb=:{symb_arity, symb_kind = SK_IclMacro glob_object}, app_args}) ei + expand (App app=:{app_symb = symb=:{symb_kind = SK_IclMacro glob_object}, app_args}) ei # (app_args, (calls, es)) = expand app_args ei # (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 == length app_args = unfoldMacro macro app_args False (calls, es) # macro = {macro & fun_info.fi_group_index=if (macro_group_index<NoIndex) (-2-macro_group_index) macro_group_index} @@ -1794,10 +1794,10 @@ where collectVariables (App app=:{app_symb={symb_kind=SK_Function {glob_object,glob_module}},app_args}) free_vars cos=:{cos_predef_symbols_for_transform={predef_and,predef_or}} # ([e1,e2:_], free_vars, cos) = collectVariables app_args free_vars cos | glob_object==predef_and.pds_def && glob_module==predef_and.pds_module && two_args app_args - # (kase,cos) = if_expression e1 e2 (BasicExpr (BVB False) BT_Bool) cos + # (kase,cos) = if_expression e1 e2 (BasicExpr (BVB False)) cos = (kase, free_vars, cos) | glob_object==predef_or.pds_def && glob_module==predef_or.pds_module && two_args app_args - # (kase,cos) = if_expression e1 (BasicExpr (BVB True) BT_Bool) e2 cos + # (kase,cos) = if_expression e1 (BasicExpr (BVB True)) e2 cos = (kase, free_vars, cos) where if_expression :: Expression Expression Expression *CollectState -> (!Expression,!.CollectState); @@ -1805,9 +1805,7 @@ where # (new_info_ptr,symbol_heap) = newPtr EI_Empty cos.cos_symbol_heap # kase = Case { case_expr=e1, case_guards=BasicPatterns BT_Bool [{bp_value=BVB True,bp_expr=e2,bp_position=NoPos}], case_default=Yes e3, case_ident=No, case_info_ptr=new_info_ptr, case_default_pos = NoPos, -// RWS ... case_explicit = False } -// ... RWS = (kase,{cos & cos_symbol_heap=symbol_heap}); two_args [_,_] @@ -1893,9 +1891,7 @@ where # (new_app_info_ptr, cos_symbol_heap) = newPtr EI_Empty cos_symbol_heap {pds_module, pds_def} = cos_predef_symbols_for_transform.predef_alias_dummy pds_ident = predefined_idents.[PD_DummyForStrictAliasFun] - app_symb = { symb_name = pds_ident, - symb_kind = SK_Function {glob_module = pds_module, glob_object = pds_def}, - symb_arity = 1 } + app_symb = { symb_name = pds_ident, symb_kind = SK_Function {glob_module = pds_module, glob_object = pds_def} } = (App { app_symb = app_symb, app_args = [bind_src], app_info_ptr = new_app_info_ptr }, { cos & cos_symbol_heap = cos_symbol_heap } ) diff --git a/frontend/type.icl b/frontend/type.icl index 9f34c7f..9f66e84 100644 --- a/frontend/type.icl +++ b/frontend/type.icl @@ -684,7 +684,7 @@ fresh_overloaded_list_type [{ap_symbol}:patterns] pd_cons_symbol pd_nil_symbol d = case patterns of [] # {ft_type,ft_symb,ft_type_ptr,ft_specials} = functions.[stdStrictLists_index].[nil_u_index] - # (fun_type_copy, ts) = determineSymbolTypeOfFunction pos ft_symb 0/*symb_arity*/ ft_type ft_type_ptr common_defs ts + # (fun_type_copy, ts) = determineSymbolTypeOfFunction pos ft_symb 0 ft_type ft_type_ptr common_defs ts {tst_args,tst_result,tst_context,tst_attr_env}=fun_type_copy -> ([tst_args],tst_result,tst_context,tst_attr_env,ts) [pattern=:{ap_symbol}] @@ -695,7 +695,7 @@ fresh_overloaded_list_type [{ap_symbol}:patterns] pd_cons_symbol pd_nil_symbol d where make_cons_type_from_decons_type stdStrictLists_index decons_u_index common_defs ts # {me_symb,me_type,me_type_ptr} = common_defs.[stdStrictLists_index].com_member_defs.[decons_u_index] - (fun_type_copy,ts) = determineSymbolTypeOfFunction pos me_symb 1/*symb_arity*/ me_type me_type_ptr common_defs ts + (fun_type_copy,ts) = determineSymbolTypeOfFunction pos me_symb 1 me_type me_type_ptr common_defs ts {tst_args,tst_arity,tst_lifted,tst_result,tst_context,tst_attr_env}=fun_type_copy # result_type = case tst_args of [t] -> t # argument_types = case tst_result.at_type of (TA _ args=:[arg1,arg2]) ->args @@ -1088,24 +1088,24 @@ storeAttribute (Yes expt_ptr) type_attribute symbol_heap storeAttribute No type_attribute symbol_heap = symbol_heap -getSymbolType :: CoercionPosition TypeInput SymbIdent *TypeState -> *(!TempSymbolType,![Special],!*TypeState); -getSymbolType pos ti=:{ti_functions,ti_common_defs,ti_main_dcl_module_n} {symb_kind = SK_Function {glob_module,glob_object}, symb_arity, symb_name} ts +getSymbolType :: CoercionPosition TypeInput SymbIdent Int *TypeState -> *(!TempSymbolType,![Special],!*TypeState); +getSymbolType pos ti=:{ti_functions,ti_common_defs,ti_main_dcl_module_n} {symb_kind = SK_Function {glob_module,glob_object}, symb_name} n_app_args ts | glob_module == ti_main_dcl_module_n | glob_object>=size ts.ts_fun_env = abort symb_name.id_name; # (fun_type, ts) = ts!ts_fun_env.[glob_object] = case fun_type of UncheckedType fun_type - # (fun_type_copy, ts) = currySymbolType fun_type symb_arity ts + # (fun_type_copy, ts) = currySymbolType fun_type n_app_args ts -> (fun_type_copy, [], ts) SpecifiedType fun_type lifted_arg_types _ # (fun_type_copy=:{tst_args,tst_arity}, ts) = freshSymbolType (Yes pos) cWithoutFreshContextVars fun_type ti_common_defs ts (fun_type_copy, ts) = currySymbolType { fun_type_copy & tst_args = lifted_arg_types ++ fun_type_copy.tst_args, - tst_arity = tst_arity + length lifted_arg_types } symb_arity ts + tst_arity = tst_arity + length lifted_arg_types } n_app_args ts -> (fun_type_copy, [], ts) CheckedType fun_type # (fun_type_copy, ts) = freshSymbolType (Yes pos) cWithFreshContextVars fun_type ti_common_defs ts - (fun_type_copy,ts) = currySymbolType fun_type_copy symb_arity ts + (fun_type_copy,ts) = currySymbolType fun_type_copy n_app_args ts -> (fun_type_copy, [], ts) _ -> abort ("getSymbolType: SK_Function "+++toString symb_name+++" "+++toString glob_object) @@ -1113,45 +1113,45 @@ getSymbolType pos ti=:{ti_functions,ti_common_defs,ti_main_dcl_module_n} {symb_k # {ft_type,ft_type_ptr,ft_specials} = ti_functions.[glob_module].[glob_object] | glob_module>=size ti_functions || glob_object>=size ti_functions.[glob_module] = abort (toString glob_module+++" "+++toString glob_object+++" "+++toString ti_main_dcl_module_n+++" "+++symb_name.id_name); - # (fun_type_copy, ts) = determineSymbolTypeOfFunction pos symb_name symb_arity ft_type ft_type_ptr ti_common_defs ts + # (fun_type_copy, ts) = determineSymbolTypeOfFunction pos symb_name n_app_args ft_type ft_type_ptr ti_common_defs ts = (fun_type_copy, get_specials ft_specials, ts) where get_specials (SP_ContextTypes specials) = specials get_specials SP_None = [] -getSymbolType pos ti {symb_kind = SK_Constructor {glob_module,glob_object}, symb_arity} ts - # (fresh_cons_type, ts) = standardRhsConstructorType pos glob_object glob_module symb_arity ti ts +getSymbolType pos ti {symb_kind = SK_Constructor {glob_module,glob_object}} n_app_args ts + # (fresh_cons_type, ts) = standardRhsConstructorType pos glob_object glob_module n_app_args ti ts = (fresh_cons_type, [], ts) -getSymbolType pos ti=:{ti_functions,ti_common_defs,ti_main_dcl_module_n} {symb_kind = SK_LocalMacroFunction glob_object, symb_arity, symb_name} ts +getSymbolType pos ti=:{ti_functions,ti_common_defs,ti_main_dcl_module_n} {symb_kind = SK_LocalMacroFunction glob_object, symb_name} n_app_args ts | glob_object>=size ts.ts_fun_env = abort symb_name.id_name; # (fun_type, ts) = ts!ts_fun_env.[glob_object] = case fun_type of UncheckedType fun_type - # (fun_type_copy, ts) = currySymbolType fun_type symb_arity ts + # (fun_type_copy, ts) = currySymbolType fun_type n_app_args ts -> (fun_type_copy, [], ts) SpecifiedType fun_type lifted_arg_types _ # (fun_type_copy=:{tst_args,tst_arity}, ts) = freshSymbolType (Yes pos) cWithoutFreshContextVars fun_type ti_common_defs ts (fun_type_copy, ts) = currySymbolType { fun_type_copy & tst_args = lifted_arg_types ++ fun_type_copy.tst_args, - tst_arity = tst_arity + length lifted_arg_types } symb_arity ts + tst_arity = tst_arity + length lifted_arg_types } n_app_args ts -> (fun_type_copy, [], ts) CheckedType fun_type # (fun_type_copy, ts) = freshSymbolType (Yes pos) cWithFreshContextVars fun_type ti_common_defs ts - (fun_type_copy,ts) = currySymbolType fun_type_copy symb_arity ts + (fun_type_copy,ts) = currySymbolType fun_type_copy n_app_args ts -> (fun_type_copy, [], ts) _ -> abort ("getSymbolType SK_LocalMacroFunction: "+++toString symb_name+++" " +++toString glob_object) // -> abort "getSymbolType (type.icl)" ---> (symb_name, glob_object, fun_type) -getSymbolType pos ti=:{ti_common_defs} {symb_kind = SK_OverloadedFunction {glob_module,glob_object}, symb_arity} ts +getSymbolType pos ti=:{ti_common_defs} {symb_kind = SK_OverloadedFunction {glob_module,glob_object}} n_app_args ts # {me_symb, me_type,me_type_ptr} = ti_common_defs.[glob_module].com_member_defs.[glob_object] - (fun_type_copy, ts) = determineSymbolTypeOfFunction pos me_symb symb_arity me_type me_type_ptr ti_common_defs ts + (fun_type_copy, ts) = determineSymbolTypeOfFunction pos me_symb n_app_args me_type me_type_ptr ti_common_defs ts = (fun_type_copy, [], ts) // AA.. -getSymbolType pos ti=:{ti_common_defs} symbol=:{symb_kind = SK_Generic gen_glob kind} ts +getSymbolType pos ti=:{ti_common_defs} symbol=:{symb_kind = SK_Generic gen_glob kind} n_app_args ts # (found, member_glob) = getGenericMember gen_glob kind ti_common_defs | not found = abort "getSymbolType: no class for kind" - = getSymbolType pos ti {symbol & symb_kind = SK_OverloadedFunction member_glob} ts -// ..AA + = getSymbolType pos ti {symbol & symb_kind = SK_OverloadedFunction member_glob} n_app_args ts +// ..AA class requirements a :: !TypeInput !a !(!u:Requirements, !*TypeState) -> (!AType, !Optional ExprInfoPtr, !(!u:Requirements, !*TypeState)) @@ -1184,7 +1184,7 @@ where instance requirements App where requirements ti app=:{app_symb,app_args,app_info_ptr} (reqs=:{req_attr_coercions}, ts) - # (tst=:{tst_attr_env,tst_args,tst_result,tst_context}, specials, ts) = getSymbolType (CP_Expression (App app)) ti app_symb ts + # (tst=:{tst_attr_env,tst_args,tst_result,tst_context}, specials, ts) = getSymbolType (CP_Expression (App app)) ti app_symb (length app_args) ts reqs = { reqs & req_attr_coercions = tst_attr_env ++ req_attr_coercions } (reqs, ts) = requirements_of_args ti app_symb.symb_name 1 app_args tst_args (reqs, ts) | isEmpty tst_context @@ -1532,11 +1532,21 @@ where ts_expr_heap = storeAttribute opt_expr_ptr argtype.at_attribute ts.ts_expr_heap = (tst_result, No, ({ reqs & req_type_coercions = req_type_coercions }, { ts & ts_expr_heap = ts_expr_heap })) - - requirements _ (BasicExpr basic_val basic_type) (reqs, ts) + requirements _ (BasicExpr basic_val) (reqs, ts) + # basic_type = typeOfBasicValue basic_val # (type, ts) = attributedBasicType basic_type ts = (type, No, (reqs, ts)) + where + typeOfBasicValue :: !BasicValue -> Box Type + typeOfBasicValue (BVI _) = basicIntType + typeOfBasicValue (BVInt _) = basicIntType + typeOfBasicValue (BVC _) = basicCharType + typeOfBasicValue (BVB _) = basicBoolType + typeOfBasicValue (BVR _) = basicRealType + typeOfBasicValue (BVS _) = basicStringType + attributedBasicType {box=type} ts=:{ts_attr_store} + = ({ at_annotation = AN_None, at_attribute = TA_TempVar ts_attr_store, at_type = type}, {ts & ts_attr_store = inc ts_attr_store}) requirements ti (MatchExpr opt_tuple_type {glob_object={ds_arity, ds_index},glob_module} expr) (reqs, ts) # cp = CP_Expression expr @@ -1562,6 +1572,13 @@ where requirements _ expr reqs_ts = (abort ("Error in requirements\n" ---> expr), No, reqs_ts) +:: Box a = { box :: !a} + +basicIntType =: {box=TB BT_Int} +basicCharType =: {box=TB BT_Char} +basicBoolType =: {box=TB BT_Bool} +basicRealType =: {box=TB BT_Real} +basicStringType =: {box=TA (MakeTypeSymbIdent { glob_object = PD_StringTypeIndex, glob_module = cPredefinedModuleIndex } predefined_idents.[PD_StringType] 0) []} requirementsOfSelectors ti opt_expr expr [selector] tc_coercible change_uselect sel_expr_type sel_expr reqs_ts = requirementsOfSelector ti opt_expr expr selector tc_coercible change_uselect sel_expr_type sel_expr reqs_ts @@ -1575,7 +1592,7 @@ requirementsOfSelector ti _ expr (RecordSelection field _) tc_coercible change_u req_type_coercions = [{ tc_demanded = hd tst_args, tc_offered = sel_expr_type, tc_position = CP_Expression sel_expr, tc_coercible = tc_coercible } : reqs.req_type_coercions ] = (False, tst_result, ({ reqs & req_type_coercions = req_type_coercions }, ts)) -requirementsOfSelector ti opt_expr expr (ArraySelection {glob_object = {ds_ident,ds_index,ds_arity},glob_module} expr_ptr index_expr) tc_coercible change_uselect sel_expr_type sel_expr (reqs, ts) +requirementsOfSelector ti opt_expr expr (ArraySelection {glob_object = {ds_ident,ds_index},glob_module} expr_ptr index_expr) tc_coercible change_uselect sel_expr_type sel_expr (reqs, ts) # {me_type} = ti.ti_common_defs.[glob_module].com_member_defs.[ds_index] ({tst_attr_env,tst_args,tst_result,tst_context}, ts) = freshSymbolType (Yes (CP_Expression expr)) cWithFreshContextVars me_type ti.ti_common_defs ts # (tst_args, tst_result, ts) @@ -1597,7 +1614,7 @@ requirementsOfSelector ti opt_expr expr (ArraySelection {glob_object = {ds_ident = (True, tst_result, (reqs, ts)) = (True, tst_result, ({ reqs & req_overloaded_calls = [expr_ptr : reqs.req_overloaded_calls ]}, { ts & ts_expr_heap = ts.ts_expr_heap <:= (expr_ptr, EI_Overloaded { oc_symbol = - { symb_name = ds_ident, symb_kind = SK_OverloadedFunction {glob_module = glob_module, glob_object = ds_index}, symb_arity = ds_arity }, + { symb_name = ds_ident, symb_kind = SK_OverloadedFunction {glob_module = glob_module, glob_object = ds_index}}, oc_context = tst_context, oc_specials = [] })})) where array_and_index_type [array_type, index_type : rest_type ] @@ -1770,7 +1787,7 @@ where (pds, predef_symbols) = predef_symbols![PD_TypeCodeMember] ({pds_module,pds_def},predef_symbols) = predef_symbols![PD_TypeCodeMember] pds_ident = predefined_idents.[PD_TypeCodeMember] - tc_member_symb = { symb_name = pds_ident, symb_kind = SK_OverloadedFunction {glob_module = pds_module, glob_object = pds_def }, symb_arity = 0} + tc_member_symb = { symb_name = pds_ident, symb_kind = SK_OverloadedFunction {glob_module = pds_module, glob_object = pds_def }} (new_var_ptr, var_heap) = newPtr VI_Empty var_heap context = {tc_class = tc_class_symb, tc_types = [fresh_var], tc_var = new_var_ptr} (expr_ptr, expr_heap) = newPtr EI_Empty expr_heap //---> ("^EI_Dynamic No=" +++ toString var_store) @@ -1831,7 +1848,7 @@ where tc_class_symb = {glob_module = pds_module, glob_object = {ds_ident = pds_ident, ds_arity = 1, ds_index = pds_def }} ({pds_module,pds_def},predef_symbols) = predef_symbols![PD_TypeCodeMember] pds_ident = predefined_idents.[PD_TypeCodeMember] - tc_member_symb = { symb_name = pds_ident, symb_kind = SK_TypeCode, symb_arity = 0} + tc_member_symb = { symb_name = pds_ident, symb_kind = SK_TypeCode} (contexts, (var_heap, type_var_heap)) = mapSt (build_type_context tc_class_symb) global_vars (var_heap, type_var_heap) (expr_ptr, expr_heap) = newPtr EI_Empty expr_heap = (contexts, expr_ptr, tc_member_symb, (var_heap, expr_heap, type_var_heap, predef_symbols)) @@ -1855,10 +1872,9 @@ specification_error type type1 err <:: (format, type, Yes initialTypeVarBeautifulizer) <<< '\n' } - cleanUpAndCheckFunctionTypes [] _ _ start_index _ defs type_contexts coercion_env attr_partition type_var_env attr_var_env (fun_defs, ts) = (fun_defs, ts) -cleanUpAndCheckFunctionTypes [fun : funs] [ {fe_requirements = {req_case_and_let_exprs}} : reqs] dict_types start_index list_inferred_types defs type_contexts coercion_env +cleanUpAndCheckFunctionTypes [fun : funs] [ {fe_requirements={req_case_and_let_exprs}} : reqs] dict_types start_index list_inferred_types defs type_contexts coercion_env attr_partition type_var_env attr_var_env (fun_defs, ts) # (fd, fun_defs) = fun_defs![fun] dict_ptrs = get_dict_ptrs fun dict_types @@ -2319,7 +2335,6 @@ where collect_and_expand_overloaded_calls [] calls subst_and_heap = (calls, subst_and_heap) - collect_and_expand_overloaded_calls [{ fe_context=Yes context, fe_requirements={req_overloaded_calls,req_case_and_let_exprs}, fe_location, fe_index}:reqs] calls (subst, expr_heap) # (_, context, subst) = arraySubst context subst subst_expr_heap = expand_case_or_let_types req_case_and_let_exprs (subst, expr_heap) |