diff options
-rw-r--r-- | frontend/check.dcl | 5 | ||||
-rw-r--r-- | frontend/check.icl | 30 | ||||
-rw-r--r-- | frontend/frontend.icl | 7 |
3 files changed, 26 insertions, 16 deletions
diff --git a/frontend/check.dcl b/frontend/check.dcl index 64bc1c0..a9ce1aa 100644 --- a/frontend/check.dcl +++ b/frontend/check.dcl @@ -11,8 +11,9 @@ checkFunctions :: !Index !Level !Index !Index !Int !*{#FunDef} !*ExpressionInfo checkDclMacros :: !Index !Level !Index !Index !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState) -checkForeignExportedFunctionTypes :: !*ErrorAdmin ![ForeignExport] !*{#FunDef} -> (!*ErrorAdmin,!*{#FunDef}) - +checkForeignExportedFunctionTypes :: ![ForeignExport] !*ErrorAdmin !p:PredefinedSymbols !*{#FunDef} + -> (!*ErrorAdmin,!p:PredefinedSymbols,!*{#FunDef}) + determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials !*TypeHeaps !u:(Optional (v:{#DclModule}, w:{#CheckedTypeDef}, Index)) !*ErrorAdmin -> (!SymbolType, !Specials, !*TypeHeaps, !u:Optional (v:{#DclModule}, w:{#CheckedTypeDef}), !*ErrorAdmin) diff --git a/frontend/check.icl b/frontend/check.icl index 7611b84..e7671ec 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -2851,15 +2851,16 @@ checkForeignExports [{pfe_ident=pfe_ident=:{id_name,id_info},pfe_line,pfe_file,p checkForeignExports [] icl_global_functions_ranges fun_defs cs = ([],fun_defs,cs) -checkForeignExportedFunctionTypes :: !*ErrorAdmin ![ForeignExport] !*{#FunDef} -> (!*ErrorAdmin,!*{#FunDef}) -checkForeignExportedFunctionTypes error_admin [{fe_fd_index}:icl_foreign_exports] fun_defs - # error_admin = if (check_foreign_export_type st_result.at_type) - error_admin - (checkErrorWithIdentPos (newPosition fun_ident fun_pos) "error in result type for foreign exported function" error_admin) - # error_admin = if (check_foreign_export_types st_args) - error_admin - (checkErrorWithIdentPos (newPosition fun_ident fun_pos) "error in argument type for foreign exported function" error_admin) - = checkForeignExportedFunctionTypes error_admin icl_foreign_exports fun_defs2 +checkForeignExportedFunctionTypes :: ![ForeignExport] !*ErrorAdmin !p:PredefinedSymbols !*{#FunDef} + -> (!*ErrorAdmin,!p:PredefinedSymbols,!*{#FunDef}) +checkForeignExportedFunctionTypes [{fe_fd_index}:icl_foreign_exports] error_admin predefined_symbols fun_defs + | not (check_foreign_export_type st_result.at_type) + # error_admin = checkErrorWithIdentPos (newPosition fun_ident fun_pos) "error in result type for foreign exported function" error_admin + = checkForeignExportedFunctionTypes icl_foreign_exports error_admin predefined_symbols fun_defs2 + | not (check_foreign_export_types st_args) + # error_admin = checkErrorWithIdentPos (newPosition fun_ident fun_pos) "error in argument type for foreign exported function" error_admin + = checkForeignExportedFunctionTypes icl_foreign_exports error_admin predefined_symbols fun_defs2 + = checkForeignExportedFunctionTypes icl_foreign_exports error_admin predefined_symbols fun_defs2 where ({fun_type=Yes {st_args,st_result},fun_ident,fun_pos},fun_defs2) = fun_defs![fe_fd_index] @@ -2872,13 +2873,20 @@ checkForeignExportedFunctionTypes error_admin [{fe_fd_index}:icl_foreign_exports = True check_foreign_export_type (TB BT_Real) = True + check_foreign_export_type (TB (BT_String _)) + = True + check_foreign_export_type (TA {type_index={glob_module,glob_object},type_arity} [{at_type=TB BT_Char}]) + | predefined_symbols.[PD_UnboxedArrayType].pds_def==glob_object && + predefined_symbols.[PD_UnboxedArrayType].pds_module==glob_module + = True + = False check_foreign_export_type (TAS {type_arity,type_index={glob_object,glob_module}} arguments strictness) = glob_module==cPredefinedModuleIndex && glob_object==PD_Arity2TupleTypeIndex+(type_arity-2) && first_n_are_strict type_arity strictness && check_foreign_export_types arguments check_foreign_export_type _ = False -checkForeignExportedFunctionTypes error_admin [] fun_defs - = (error_admin,fun_defs) +checkForeignExportedFunctionTypes [] error_admin predefined_symbols fun_defs + = (error_admin,predefined_symbols,fun_defs) check_needed_modules_are_imported mod_ident extension cs=:{cs_x={x_needed_modules}} # cs = case x_needed_modules bitand cNeedStdGeneric of diff --git a/frontend/frontend.icl b/frontend/frontend.icl index 4ad20c1..6b48483 100644 --- a/frontend/frontend.icl +++ b/frontend/frontend.icl @@ -32,7 +32,7 @@ frontSyntaxTree cached_dcl_macros cached_dcl_mods main_dcl_module_n predef_symbo frontEndInterface :: !FrontEndOptions !Ident !SearchPaths !{#DclModule} !*{#*{#FunDef}} !(Optional Bool) !*PredefinedSymbols !*HashTable (ModTimeFunction *Files) !*Files !*File !*File !*File !(Optional *File) !*Heaps -> ( !Optional *FrontEndSyntaxTree,!*{#*{#FunDef}},!{#DclModule},!Int,!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File, !Optional *File, !*Heaps) -frontEndInterface options mod_ident search_paths cached_dcl_modules functions_and_macros list_inferred_types predef_symbols hash_table modtimefunction files error io out tcl_file heaps +frontEndInterface options mod_ident search_paths cached_dcl_modules cached_dcl_macros list_inferred_types predef_symbols hash_table modtimefunction files error io out tcl_file heaps // # files = trace_n ("Compiling "+++mod_ident.id_name) files # (ok, mod, hash_table, error, files) = wantModule cWantIclFile mod_ident NoPos options.feo_generics(hash_table /* ---> ("Parsing:", mod_ident)*/) error search_paths modtimefunction files @@ -53,7 +53,7 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an # (ok, icl_mod, dcl_mods, components, cached_dcl_macros,main_dcl_module_n,heaps, predef_symbols, symbol_table, error, directly_imported_dcl_modules) - = checkModule support_dynamics mod global_fun_range mod_functions dcl_module_n_in_cache optional_dcl_mod modules cached_dcl_modules functions_and_macros predef_symbols (symbol_table -*-> "Checking") error heaps + = checkModule support_dynamics mod global_fun_range mod_functions dcl_module_n_in_cache optional_dcl_mod modules cached_dcl_modules cached_dcl_macros predef_symbols (symbol_table -*-> "Checking") error heaps hash_table = { hash_table & hte_symbol_heap = symbol_table} @@ -220,7 +220,8 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an = (pds_def, predef_symbols) = (NoIndex, predef_symbols) - # (error_admin,fun_defs) = checkForeignExportedFunctionTypes error_admin icl_foreign_exports fun_defs + # (error_admin,predef_symbols,fun_defs) + = checkForeignExportedFunctionTypes icl_foreign_exports error_admin predef_symbols fun_defs # [icl_exported_global_functions,icl_not_exported_global_functions:_] = icl_global_functions # exported_global_functions = case start_rule_index of |