diff options
Diffstat (limited to 'frontend')
| -rw-r--r-- | frontend/check.icl | 27 | ||||
| -rw-r--r-- | frontend/explicitimports.icl | 1 | ||||
| -rw-r--r-- | frontend/frontend.icl | 2 | ||||
| -rw-r--r-- | frontend/parse.dcl | 2 | ||||
| -rw-r--r-- | frontend/parse.icl | 40 | ||||
| -rw-r--r-- | frontend/postparse.icl | 66 | ||||
| -rw-r--r-- | frontend/refmark.icl | 6 | ||||
| -rw-r--r-- | frontend/syntax.dcl | 10 | ||||
| -rw-r--r-- | frontend/syntax.icl | 10 | ||||
| -rw-r--r-- | frontend/type.icl | 143 | ||||
| -rw-r--r-- | frontend/typesupport.dcl | 2 | ||||
| -rw-r--r-- | frontend/typesupport.icl | 7 | ||||
| -rw-r--r-- | frontend/unitype.dcl | 2 | ||||
| -rw-r--r-- | frontend/unitype.icl | 15 |
14 files changed, 245 insertions, 88 deletions
diff --git a/frontend/check.icl b/frontend/check.icl index 643b22d..99b941f 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -1072,7 +1072,7 @@ where check_id_expression :: !SymbolTableEntry !Bool ![FreeVar] !Ident !ExpressionInput !*ExpressionState !u:ExpressionInfo !*CheckState -> (!Expression, ![FreeVar], !*ExpressionState, !u:ExpressionInfo, !*CheckState) check_id_expression {ste_kind = STE_Empty} is_expr_list free_vars id e_input e_state e_info cs=:{cs_error} - = (EE, free_vars, e_state, e_info, { cs & cs_error = checkError id " undefined" cs_error }) + = (EE, free_vars, e_state, e_info, { cs & cs_error = checkError id "undefined" cs_error }) check_id_expression {ste_kind = STE_Variable info_ptr,ste_def_level} is_expr_list free_vars id e_input=:{ei_fun_level} e_state=:{es_expr_heap} e_info cs | ste_def_level < ei_fun_level # free_var = { fv_def_level = ste_def_level, fv_name = id, fv_info_ptr = info_ptr, fv_count = 0 } @@ -2277,9 +2277,8 @@ checkFunction :: !Index !Index !Level !*{#FunDef} !*ExpressionInfo !*Heaps !*Che checkFunction mod_index fun_index def_level fun_defs e_info=:{ef_type_defs,ef_modules,ef_class_defs,ef_is_macro_fun} heaps=:{hp_var_heap,hp_expression_heap,hp_type_heaps} cs=:{cs_error} # (fun_def,fun_defs) = fun_defs![fun_index] - # {fun_symb,fun_pos,fun_body,fun_type} = fun_def - position = newPosition fun_symb fun_pos - cs = { cs & cs_error = pushErrorAdmin position cs_error } + # {fun_symb,fun_pos,fun_body,fun_type,fun_kind} = fun_def + cs = { cs & cs_error = push_error_admin_beautifully fun_symb fun_pos fun_kind cs_error } (fun_type, ef_type_defs, ef_class_defs, ef_modules, hp_var_heap, hp_type_heaps, cs) = check_function_type fun_type mod_index ef_type_defs ef_class_defs ef_modules hp_var_heap hp_type_heaps cs e_info = { e_info & ef_type_defs = ef_type_defs, ef_class_defs = ef_class_defs, ef_modules = ef_modules } @@ -2325,7 +2324,13 @@ where get_calls (STE_FunctionOrMacro [x:xs]) = (x,xs) get_calls ste_kind = abort "get_calls (check.icl)" // <<- ste_kind - + push_error_admin_beautifully {id_name} fun_pos (FK_Function fun_name_is_location_dependent) cs_error + | fun_name_is_location_dependent && size id_name>0 + # beautiful_name = if (id_name.[0]==backslash) "lambda" "comprehension" + = pushErrorAdmin (newPosition { id_name=beautiful_name, id_info=nilPtr } fun_pos) cs_error + push_error_admin_beautifully fun_symb fun_pos _ cs_error + = pushErrorAdmin (newPosition fun_symb fun_pos) cs_error + checkFunctions :: !Index !Level !Index !Index !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef}, !*ExpressionInfo, !*Heaps, !*CheckState) checkFunctions mod_index level from_index to_index fun_defs e_info heaps cs | from_index == to_index @@ -2437,6 +2442,7 @@ where # ({fun_symb, fun_pos}, fun_defs) = fun_defs![dcl_index] = ([{ dcl_ident = fun_symb, dcl_pos = fun_pos, dcl_kind = STE_FunctionOrMacro [], dcl_index = dcl_index } : defs], fun_defs) +combineDclAndIclModule :: !ModuleKind !*{#DclModule} ![Declaration] !(CollectedDefinitions b c) !*{#Int} !*CheckState -> (!*{#DclModule},![Declaration],!CollectedDefinitions b c,!*{#Int},!*CheckState); combineDclAndIclModule MK_Main modules icl_decl_symbols icl_definitions icl_sizes cs = (modules, icl_decl_symbols, icl_definitions, icl_sizes, cs) combineDclAndIclModule _ modules icl_decl_symbols icl_definitions icl_sizes cs @@ -2446,9 +2452,9 @@ combineDclAndIclModule _ modules icl_decl_symbols icl_definitions icl_sizes cs (moved_dcl_defs, conversion_table, icl_sizes, icl_decl_symbols, cs) = foldSt (add_to_conversion_table dcl_macros.ir_from) dcls_local ([], { createArray size NoIndex \\ size <-: dcl_sizes }, icl_sizes, icl_decl_symbols, cs) + (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, cs) = foldSt (add_dcl_definition dcl_common) moved_dcl_defs ([], [], [], [], [], cs) - cs_symbol_table = removeDeclarationsFromSymbolTable icl_decl_symbols cGlobalScope cs.cs_symbol_table = ( { modules & [cIclModIndex] = { dcl_mod & dcl_conversions = Yes conversion_table }} @@ -2463,7 +2469,6 @@ combineDclAndIclModule _ modules icl_decl_symbols icl_definitions icl_sizes cs , icl_sizes , { cs & cs_symbol_table = cs_symbol_table } ) - where add_to_conversion_table first_macro_index decl=:{dcl_ident=dcl_ident=:{id_info},dcl_kind,dcl_index,dcl_pos} (moved_dcl_defs, conversion_table, icl_sizes, icl_defs, cs) @@ -3122,11 +3127,11 @@ checkDclModule is_on_cycle {mod_name,mod_imports,mod_defs} mod_index modules icl dcl_class_specials = { ir_from = first_special_class_index, ir_to = last_special_class_index }} = ({ modules & [ mod_index ] = dcl_mod }, icl_functions, heaps, { cs & cs_symbol_table = cs_symbol_table }) where - collect_imported_symbols [{import_module={id_info},import_symbols,import_file_position} : mods ] all_decls modules cs=:{cs_symbol_table} + collect_imported_symbols [{import_module={id_info},import_symbols,import_file_position=LinePos filename line_nr} : mods ] all_decls modules cs=:{cs_symbol_table} # (entry, cs_symbol_table) = readPtr id_info cs_symbol_table # (decls_of_imported_module, modules, cs) = collect_declarations_of_module id_info entry [] modules { cs & cs_symbol_table = cs_symbol_table} (imported_decls, modules, cs) = possibly_filter_decls - import_symbols decls_of_imported_module import_file_position modules cs + import_symbols decls_of_imported_module (filename, line_nr) modules cs = collect_imported_symbols mods (imported_decls++all_decls) modules cs collect_imported_symbols [] all_decls modules cs = (all_decls, modules, cs) @@ -3244,10 +3249,10 @@ NewEntry symbol_table symb_ptr def_kind def_index level previous :== addImportsToSymbolTable :: ![ParsedImport] ![(!Declaration, !LineNr)] !*{# DclModule} !*CheckState -> (![(!Declaration, !LineNr)], !*{# DclModule}, !*CheckState) -addImportsToSymbolTable [{import_module={id_info},import_symbols, import_file_position} : mods ] explicit_akku modules cs=:{cs_symbol_table} +addImportsToSymbolTable [{import_module={id_info},import_symbols, import_file_position=LinePos filename line_nr} : mods ] explicit_akku modules cs=:{cs_symbol_table} # ({ste_index}, cs_symbol_table) = readPtr id_info cs_symbol_table # ({dcl_declared=decls_of_imported_module}, modules) = modules![ste_index] - (imported_decls, modules, cs) = possibly_filter_decls import_symbols [(ste_index, decls_of_imported_module)] import_file_position + (imported_decls, modules, cs) = possibly_filter_decls import_symbols [(ste_index, decls_of_imported_module)] (filename, line_nr) modules { cs & cs_symbol_table = cs_symbol_table } | isEmpty imported_decls = addImportsToSymbolTable mods explicit_akku modules cs diff --git a/frontend/explicitimports.icl b/frontend/explicitimports.icl index 2b6133c..35e9b06 100644 --- a/frontend/explicitimports.icl +++ b/frontend/explicitimports.icl @@ -30,6 +30,7 @@ do_temporary_import_solution_XXX :== temporary_import_solution_XXX True False :: OptimizeInfo :== Optional Index +// XXX change !(!FileName,!LineNr) into Position possibly_filter_decls :: ![ImportDeclaration] ![(!Index,!Declarations)] !(!FileName,!LineNr) !*{#DclModule} !*CheckState -> (![(!Index,!Declarations)],!.{#DclModule},!.CheckState) possibly_filter_decls [] decls_of_imported_module _ modules cs // implicit import can't go wrong diff --git a/frontend/frontend.icl b/frontend/frontend.icl index 163dc44..32e8da5 100644 --- a/frontend/frontend.icl +++ b/frontend/frontend.icl @@ -75,7 +75,7 @@ instance == FrontEndPhase where frontEndInterface :: !FrontEndPhase !Ident !SearchPaths !*PredefinedSymbols !*HashTable !*Files !*File !*File !*File -> (!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File, !Optional *FrontEndSyntaxTree) frontEndInterface upToPhase mod_ident search_paths predef_symbols hash_table files error io out # (ok, mod, hash_table, error, predef_symbols, files) - = wantModule cWantIclFile mod_ident (hash_table -*-> ("Parsing:", mod_ident)) error search_paths predef_symbols files + = wantModule cWantIclFile mod_ident NoPos (hash_table -*-> ("Parsing:", mod_ident)) error search_paths predef_symbols files | not ok = (predef_symbols, hash_table, files, error, io, out, No) # (ok, mod, global_fun_range, mod_functions, dcl_mod, predef_mod, modules, hash_table, error, predef_symbols, files) diff --git a/frontend/parse.dcl b/frontend/parse.dcl index 6790bab..8bf549b 100644 --- a/frontend/parse.dcl +++ b/frontend/parse.dcl @@ -10,5 +10,5 @@ import syntax, hashtable, scanner, predef cWantIclFile :== True cWantDclFile :== False -wantModule :: !Bool !Ident !*HashTable !*File !SearchPaths !*PredefinedSymbols !*Files +wantModule :: !Bool !Ident !Position !*HashTable !*File !SearchPaths !*PredefinedSymbols !*Files -> (!Bool, !ParsedModule, !*HashTable, !*File, !*PredefinedSymbols, !*Files) diff --git a/frontend/parse.icl b/frontend/parse.icl index d7f4049..d5f6a60 100644 --- a/frontend/parse.icl +++ b/frontend/parse.icl @@ -244,14 +244,17 @@ isIclContext context :== not (isDclContext context) cWantIclFile :== True cWantDclFile :== False -wantModule :: !Bool !Ident !*HashTable !*File !SearchPaths !*PredefinedSymbols !*Files +// MW3 was:wantModule :: !Bool !Ident !*HashTable !*File !SearchPaths !*PredefinedSymbols !*Files +wantModule :: !Bool !Ident !Position !*HashTable !*File !SearchPaths !*PredefinedSymbols !*Files -> (!Bool, !ParsedModule, !*HashTable, !*File, !*PredefinedSymbols, !*Files) -wantModule iclmodule file_id=:{id_name} hash_table error searchPaths pre_def_symbols files +wantModule iclmodule file_id=:{id_name} import_file_position hash_table error searchPaths pre_def_symbols files # file_name = if iclmodule (id_name +++ ".icl") (id_name +++ ".dcl") = case openScanner file_name searchPaths files of (Yes scanState, files) -> initModule file_name scanState hash_table error pre_def_symbols files (No , files) -> let mod = { mod_name = file_id, mod_type = MK_None, mod_imports = [], mod_imported_objects = [], mod_defs = [] } in - (False, mod, hash_table, error <<< "Could not open: " <<< file_name <<< "\n", pre_def_symbols, files) +// MW3 was: (False, mod, hash_table, error <<< "Could not open: " <<< file_name <<< "\n", pre_def_symbols, files) + (False, mod, hash_table, error <<< import_file_position <<< ":could not open " <<< file_name <<< "\n", + pre_def_symbols, files) where initModule :: String ScanState !*HashTable !*File !*PredefinedSymbols *Files -> (!Bool, !ParsedModule, !*HashTable, !*File, !*PredefinedSymbols, !*Files) @@ -779,7 +782,7 @@ wantImports pState # (names, pState) = wantIdents FunctionContext IC_Module pState (file_name, line_nr, pState) = getFileAndLineNr pState pState = wantEndOfDefinition "imports" pState - = (map (\name -> { import_module = name, import_symbols = [], import_file_position = (file_name, line_nr)}) names, pState) + = (map (\name -> { import_module = name, import_symbols = [], import_file_position = LinePos file_name line_nr}) names, pState) wantFromImports :: !ParseState -> (!ParsedImport, !ParseState) wantFromImports pState @@ -789,7 +792,7 @@ wantFromImports pState (file_name, line_nr, pState) = getFileAndLineNr pState (import_symbols, pState) = wantSequence CommaToken GeneralContext pState pState = wantEndOfDefinition "from imports" pState - = ( { import_module = mod_ident, import_symbols = import_symbols, import_file_position = (file_name, line_nr) }, pState) + = ( { import_module = mod_ident, import_symbols = import_symbols, import_file_position = LinePos file_name line_nr }, pState) instance want ImportedObject where want pState @@ -1952,7 +1955,8 @@ trySimpleExpressionT token is_pattern pState trySimpleNonLhsExpressionT :: !Token *ParseState -> *(!Bool,!ParsedExpr,!*ParseState) trySimpleNonLhsExpressionT BackSlashToken pState - # (lam_ident, pState) = internalIdent "\\" pState +// MW3 was: # (lam_ident, pState) = internalIdent "\\" pState + # (lam_ident, pState) = internalIdent (toString backslash) pState (lam_args, pState) = wantList "arguments" trySimpleLhsExpression pState pState = want_lambda_sep pState (exp, pState) = wantExpression cIsNotAPattern pState @@ -2101,17 +2105,22 @@ where want_qualifier :: !ParseState -> (!Qualifier, !ParseState) want_qualifier pState # (qual_position, pState) = getPosition pState + (qual_filename, pState) = accScanState getFilename pState //MW3++ (lhs_expr, pState) = wantExpression cIsAPattern pState (token, pState) = nextToken FunctionContext pState | token == LeftArrowToken - = want_generators cIsListGenerator (toLineAndColumn qual_position) lhs_expr pState +//MW3 was: = want_generators cIsListGenerator (toLineAndColumn qual_position) lhs_expr pState + = want_generators cIsListGenerator (toLineAndColumn qual_position) qual_filename lhs_expr pState | token == LeftArrowColonToken - = want_generators cIsArrayGenerator (toLineAndColumn qual_position) lhs_expr pState - = ({qual_generators = [], qual_filter = No, qual_position = {lc_line = 0, lc_column = 0}}, +//MW3 was: = want_generators cIsArrayGenerator (toLineAndColumn qual_position) lhs_expr pState + = want_generators cIsArrayGenerator (toLineAndColumn qual_position) qual_filename lhs_expr pState + = ({qual_generators = [], qual_filter = No, qual_position = {lc_line = 0, lc_column = 0}, qual_filename = "" }, parseError "comprehension: qualifier" (Yes token) "qualifier(s)" pState) - want_generators :: !GeneratorKind !LineAndColumn !ParsedExpr !ParseState -> (!Qualifier, !ParseState) - want_generators gen_kind qual_position pattern_exp pState +//MW3 was: want_generators :: !GeneratorKind !LineAndColumn !ParsedExpr !ParseState -> (!Qualifier, !ParseState) +//MW3 was: want_generators gen_kind qual_position pattern_exp pState + want_generators :: !GeneratorKind !LineAndColumn !FileName !ParsedExpr !ParseState -> (!Qualifier, !ParseState) + want_generators gen_kind qual_position qual_filename pattern_exp pState # (gen_position, pState) = getPosition pState # (gen_expr, pState) = wantExpression cIsNotAPattern pState (token, pState) = nextToken FunctionContext pState @@ -2120,11 +2129,16 @@ where } | token == BarToken # (filter_expr, pState) = wantExpression cIsNotAPattern pState - = ({qual_generators = [generator], qual_filter = Yes filter_expr, qual_position = qual_position }, pState) + = ( { qual_generators = [generator], qual_filter = Yes filter_expr + , qual_position = qual_position, qual_filename = qual_filename } //MW3 added qual_filename field + , pState + ) | token == AndToken # (qualifier, pState) = want_qualifier pState = ({qualifier & qual_generators = [ generator : qualifier.qual_generators] }, pState) - = ({qual_generators = [generator], qual_filter = No, qual_position = qual_position}, tokenBack pState) + = ( {qual_generators = [generator], qual_filter = No, qual_position = qual_position, qual_filename = qual_filename} //MW3 added qual_filename field + , tokenBack pState + ) /** Case Expressions diff --git a/frontend/postparse.icl b/frontend/postparse.icl index 5217c0c..282dc16 100644 --- a/frontend/postparse.icl +++ b/frontend/postparse.icl @@ -404,10 +404,12 @@ transformGenerator {gen_kind, gen_expr, gen_pattern, gen_position} ca , tq_success :: ParsedExpr , tq_end :: ParsedExpr , tq_fun_id :: Ident + , tq_fun_pos :: !Position // MW3++ } transformQualifier :: Qualifier *CollectAdmin -> (TransformedQualifier, *CollectAdmin) -transformQualifier {qual_generators, qual_filter, qual_position} ca +//MW3 was:transformQualifier {qual_generators, qual_filter, qual_position} ca +transformQualifier {qual_generators, qual_filter, qual_position, qual_filename} ca # (transformedGenerators, ca) = mapSt transformGenerator qual_generators ca # (qual_fun_id, ca) @@ -420,11 +422,13 @@ transformQualifier {qual_generators, qual_filter, qual_position} ca , tq_success = PE_Empty , tq_end = PE_Empty , tq_fun_id = qual_fun_id + , tq_fun_pos = LinePos qual_filename qual_position.lc_line // MW3++ }, ca) // =array&callArray are misnomers (can also be records) transformUpdateQualifier :: ParsedExpr ParsedExpr Qualifier *CollectAdmin -> (TransformedQualifier, *CollectAdmin) -transformUpdateQualifier array callArray {qual_generators, qual_filter, qual_position} ca +//MW3 was:transformUpdateQualifier array callArray {qual_generators, qual_filter, qual_position} ca +transformUpdateQualifier array callArray {qual_generators, qual_filter, qual_position, qual_filename} ca # (transformedGenerators, ca) = mapSt transformGenerator qual_generators ca # (qual_fun_id, ca) @@ -437,6 +441,7 @@ transformUpdateQualifier array callArray {qual_generators, qual_filter, qual_pos , tq_success = PE_Empty , tq_end = PE_Empty , tq_fun_id = qual_fun_id + , tq_fun_pos = LinePos qual_filename qual_position.lc_line // MW3++ }, ca) transformComprehension :: Bool ParsedExpr [Qualifier] *CollectAdmin -> (ParsedExpr, *CollectAdmin) @@ -468,7 +473,8 @@ transformComprehension gen_kind expr qualifiers ca (create_array, ca) = get_predef_id PD__CreateArrayFun ca (length, ca) - = computeLength qualifiers qual_position ca +//MW3 was: = computeLength qualifiers qual_position ca + = computeLength qualifiers qual_position hd_qualifier.qual_filename ca new_array = PE_List [PE_Ident create_array, length] update @@ -477,8 +483,10 @@ transformComprehension gen_kind expr qualifiers ca = [{hd_qualifier & qual_generators = [index_generator : hd_qualifier.qual_generators] } : tl_qualifiers] = transformUpdateComprehension new_array update (PE_Ident c_a) qualifiers ca -computeLength :: [Qualifier] LineAndColumn *CollectAdmin -> (ParsedExpr, *CollectAdmin) -computeLength qualifiers qual_position ca +//MW3 was:computeLength :: [Qualifier] LineAndColumn *CollectAdmin -> (ParsedExpr, *CollectAdmin) +//MW3 was:computeLength qualifiers qual_position ca +computeLength :: [Qualifier] LineAndColumn FileName *CollectAdmin -> (ParsedExpr, *CollectAdmin) +computeLength qualifiers qual_position qual_filename ca # (fun_ident, ca) = prefixAndPositionToIdent "c_l" qual_position ca (tail_ident, ca) @@ -491,10 +499,19 @@ computeLength qualifiers qual_position ca = makeConsExpression PE_WildCard (PE_Ident tail_ident) ca (inc, ca) = get_predef_id PD_IncFun ca + new_fun_pos = LinePos qual_filename qual_position.lc_line // MW3++ +/* MW3 was parsedFunction1 = MakeNewParsedDef fun_ident [cons, PE_Ident i_ident] (exprToRhs (PE_List [PE_Ident fun_ident, PE_Ident tail_ident, PE_List [PE_Ident inc, PE_Ident i_ident]])) parsedFunction2 = MakeNewParsedDef fun_ident [PE_WildCard, PE_Ident i_ident] (exprToRhs (PE_Ident i_ident)) +*/ + parsedFunction1 + = MakeNewParsedDef fun_ident [cons, PE_Ident i_ident] + (exprToRhs (PE_List [PE_Ident fun_ident, PE_Ident tail_ident, PE_List [PE_Ident inc, PE_Ident i_ident]])) + new_fun_pos + parsedFunction2 + = MakeNewParsedDef fun_ident [PE_WildCard, PE_Ident i_ident] (exprToRhs (PE_Ident i_ident)) new_fun_pos = (PE_Let cIsStrict (LocalParsedDefs [parsedFunction1, parsedFunction2]) (PE_List [PE_Ident fun_ident, list, PE_Basic (BVI "0")]), ca) @@ -524,13 +541,19 @@ transformUpdateComprehension expr updateExpr identExpr [qualifier:qualifiers] ca makeComprehensions :: [TransformedQualifier] ParsedExpr (Optional ParsedExpr) *CollectAdmin -> (ParsedExpr, *CollectAdmin) makeComprehensions [] success _ ca = (success, ca) -makeComprehensions [{tq_generators, tq_filter, tq_end, tq_call, tq_lhs_args, tq_fun_id} : qualifiers] success threading ca +// MW3 was:makeComprehensions [{tq_generators, tq_filter, tq_end, tq_call, tq_lhs_args, tq_fun_id} : qualifiers] success threading ca +makeComprehensions [{tq_generators, tq_filter, tq_end, tq_call, tq_lhs_args, tq_fun_id, tq_fun_pos} : qualifiers] success threading ca # (success, ca) = makeComprehensions qualifiers success threading ca - = make_list_comprehension tq_generators tq_lhs_args success tq_end tq_filter tq_call tq_fun_id ca +// MW3 was: = make_list_comprehension tq_generators tq_lhs_args success tq_end tq_filter tq_call tq_fun_id ca + = make_list_comprehension tq_generators tq_lhs_args success tq_end tq_filter tq_call tq_fun_id tq_fun_pos ca where - make_list_comprehension :: [TransformedGenerator] [ParsedExpr] ParsedExpr ParsedExpr (Optional ParsedExpr) ParsedExpr Ident *CollectAdmin -> (ParsedExpr, *CollectAdmin) - make_list_comprehension generators lhsArgs success end optional_filter call_comprehension fun_ident ca +// MW3 was: make_list_comprehension :: [TransformedGenerator] [ParsedExpr] ParsedExpr ParsedExpr (Optional ParsedExpr) ParsedExpr Ident *CollectAdmin -> (ParsedExpr, *CollectAdmin) +// MW3 was: make_list_comprehension generators lhsArgs success end optional_filter call_comprehension fun_ident ca + make_list_comprehension :: [TransformedGenerator] [ParsedExpr] ParsedExpr ParsedExpr + (Optional ParsedExpr) ParsedExpr Ident Position *CollectAdmin + -> (ParsedExpr, *CollectAdmin) + make_list_comprehension generators lhsArgs success end optional_filter call_comprehension fun_ident fun_pos ca # continue = PE_List (thread (PE_Ident fun_ident) threading [generator.tg_rhs_continuation \\ generator <- generators]) with @@ -543,7 +566,8 @@ makeComprehensions [{tq_generators, tq_filter, tq_end, tq_call, tq_lhs_args, tq_ rhs = build_rhs generators success optional_filter failure end parsed_def - = MakeNewParsedDef fun_ident lhsArgs rhs +// MW3 was: = MakeNewParsedDef fun_ident lhsArgs rhs + = MakeNewParsedDef fun_ident lhsArgs rhs fun_pos = (PE_Let cIsStrict (LocalParsedDefs [parsed_def]) call_comprehension, ca) build_rhs :: [TransformedGenerator] ParsedExpr (Optional ParsedExpr) ParsedExpr ParsedExpr -> Rhs @@ -627,12 +651,14 @@ transformArrayDenot exprs pi scanModules :: [ParsedImport] [ScannedModule] SearchPaths *Files *CollectAdmin -> (Bool, [ScannedModule], *Files, *CollectAdmin) scanModules [] parsed_modules searchPaths files ca = (True, parsed_modules, files, ca) -scanModules [{import_module,import_symbols} : mods] parsed_modules searchPaths files ca +// MW3 was:scanModules [{import_module,import_symbols} : mods] parsed_modules searchPaths files ca +scanModules [{import_module,import_symbols,import_file_position} : mods] parsed_modules searchPaths files ca # (found, mod) = try_to_find import_module parsed_modules | found = scanModules mods parsed_modules searchPaths files ca # (succ, parsed_modules, files, ca) - = parseAndScanDclModule import_module parsed_modules searchPaths files ca +// MW3 was: = parseAndScanDclModule import_module parsed_modules searchPaths files ca + = parseAndScanDclModule import_module import_file_position parsed_modules searchPaths files ca (mods_succ, parsed_modules, files, ca) = scanModules mods parsed_modules searchPaths files ca = (succ && mods_succ, parsed_modules, files, ca) @@ -649,15 +675,18 @@ MakeEmptyModule name :== { mod_name = name, mod_type = MK_None, mod_imports = [ mod_defs = { def_types = [], def_constructors = [], def_selectors = [], def_classes = [], def_macros = { ir_from = 0, ir_to = 0 }, def_members = [], def_funtypes = [], def_instances = [] } } -parseAndScanDclModule :: !Ident ![ScannedModule] !SearchPaths !*Files !*CollectAdmin +//MW3 was:parseAndScanDclModule :: !Ident ![ScannedModule] !SearchPaths !*Files !*CollectAdmin +parseAndScanDclModule :: !Ident !Position ![ScannedModule] !SearchPaths !*Files !*CollectAdmin -> *(!Bool, ![ScannedModule], !*Files, !*CollectAdmin) -parseAndScanDclModule dcl_module parsed_modules searchPaths files ca +parseAndScanDclModule dcl_module import_file_position parsed_modules searchPaths files ca # {ca_error, ca_fun_count, ca_rev_fun_defs, ca_predefs, ca_u_predefs, ca_hash_table} = ca hash_table = ca_hash_table pea_file = ca_error.pea_file predefs = ca_u_predefs - # (parse_ok, mod, hash_table, err_file, predefs, files) = wantModule cWantDclFile dcl_module hash_table pea_file searchPaths predefs files +// MW3 was: # (parse_ok, mod, hash_table, err_file, predefs, files) = wantModule cWantDclFile dcl_module hash_table pea_file searchPaths predefs files + # (parse_ok, mod, hash_table, err_file, predefs, files) + = wantModule cWantDclFile dcl_module import_file_position hash_table pea_file searchPaths predefs files # ca = {ca_hash_table=hash_table, ca_error={pea_file=err_file,pea_ok=True}, ca_u_predefs=predefs, ca_fun_count=ca_fun_count, ca_rev_fun_defs=ca_rev_fun_defs, ca_predefs=ca_predefs} | parse_ok = scan_dcl_module mod parsed_modules searchPaths files ca @@ -722,7 +751,7 @@ where scan_dcl_module mod_name MK_None searchPaths files ca = (True, [MakeEmptyModule mod_name], files, ca) scan_dcl_module mod_name kind searchPaths files ca - = parseAndScanDclModule mod_name [] searchPaths files ca + = parseAndScanDclModule mod_name NoPos [] searchPaths files ca instance collectFunctions (ParsedInstance a) | collectFunctions a where collectFunctions inst=:{pi_members} ca @@ -743,9 +772,14 @@ MakeNewFunction name arity body kind prio opt_type pos :== { fun_symb = name, fun_arity = arity, fun_priority = prio, fun_type = opt_type, fun_kind = kind, fun_body = ParsedBody body, fun_pos = pos, fun_lifted = 0, fun_index = NoIndex, fun_info = EmptyFunInfo } +/* MW3 was // +++ position MakeNewParsedDef ident args rhs :== PD_Function NoPos ident False args rhs (FK_Function cNameLocationDependent) +*/ +// +++ position <------------ AHAAAAAAAAAAA !!!!!!!!!!!!! +MakeNewParsedDef ident args rhs pos + :== PD_Function pos ident False args rhs (FK_Function cNameLocationDependent) collectFunctionBodies :: !Ident !Int !Priority !FunKind ![ParsedDefinition] !*CollectAdmin -> (![ParsedBody], !FunKind, ![ParsedDefinition], !*CollectAdmin) diff --git a/frontend/refmark.icl b/frontend/refmark.icl index 6ecc2a3..b11c1d0 100644 --- a/frontend/refmark.icl +++ b/frontend/refmark.icl @@ -493,7 +493,8 @@ where = foldSt initial_occurrence vars (subst, type_def_infos, var_heap, expr_heap) where initial_occurrence {fv_name,fv_info_ptr} (subst, type_def_infos, var_heap, expr_heap) - # (VI_Type {at_type,at_attribute}, var_heap) = readPtr fv_info_ptr var_heap +// MW3 was: # (VI_Type {at_type,at_attribute}, var_heap) = readPtr fv_info_ptr var_heap + # (VI_Type {at_type,at_attribute} _, var_heap) = readPtr fv_info_ptr var_heap = case at_type of TempV tv_number #! is_oberving = has_observing_type type_def_infos subst.[tv_number] @@ -532,7 +533,8 @@ where | succ // ---> ("make_shared_occurrence_non_unique", free_var, var_expr_ptr) -> (coercion_env, expr_heap, error) - -> (coercion_env, expr_heap, uniquenessError { cp_expression = FreeVar free_var} " demanded attribute cannot be offered by shared object" error) +// MW3 was: -> (coercion_env, expr_heap, uniquenessError { cp_expression = FreeVar free_var} " demanded attribute cannot be offered by shared object" error) + -> (coercion_env, expr_heap, uniquenessError (CP_Expression (FreeVar free_var)) " demanded attribute cannot be offered by shared object" error) _ -> abort ("make_shared_occurrence_non_unique" ---> ((free_var, var_expr_ptr) <<- expr_info)) make_selection_non_unique fv {su_multiply} cee diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl index 32adc25..55bb2b2 100644 --- a/frontend/syntax.dcl +++ b/frontend/syntax.dcl @@ -258,7 +258,7 @@ cNameLocationDependent :== True :: Import from_symbol = { import_module :: !Ident , import_symbols :: ![from_symbol] - , import_file_position:: !(!FileName, !Int) // for error messages + , import_file_position:: !Position // for error messages } instance toString (Import from_symbol), AttributeVar, TypeAttribute, Annotation @@ -443,7 +443,7 @@ cIsALocalVar :== False :: AP_Kind = APK_Constructor !Index | APK_Macro -:: VarInfo = VI_Empty | VI_Type !AType | VI_Occurrence !Occurrence | VI_UsedVar !Ident | +:: VarInfo = VI_Empty | VI_Type !AType !(Optional CoercionPosition) | VI_Occurrence !Occurrence | VI_UsedVar !Ident | VI_Expression !Expression | VI_Variable !Ident !VarInfoPtr | VI_LiftedVariable !VarInfoPtr | VI_Count !Int /* the reference count of a variable */ !Bool /* true if the variable is global, false otherwise */ | VI_AccVar !ConsClass !ArgumentPosition /* used during fusion to determine accumulating parameters of functions */ | @@ -943,6 +943,7 @@ cIsArrayGenerator :== False { qual_generators :: ![Generator] , qual_filter :: !Optional ParsedExpr , qual_position :: !LineAndColumn + , qual_filename :: !FileName } :: Sequence = SQ_FromThen ParsedExpr ParsedExpr @@ -1112,6 +1113,10 @@ cIsNotStrict :== False | PreDefPos Ident | NoPos +:: CoercionPosition + = CP_Expression !Expression + | CP_FunArg !Ident !Int // Function symbol, argument position (>=1) + :: IdentPos = { ip_ident :: !Ident , ip_line :: !Int @@ -1202,3 +1207,4 @@ MakeDefinedSymbol ident index arity :== { ds_ident = ident, ds_arity = arity, ds MakeNewFunctionType name arity prio type pos specials var_ptr :== { ft_symb = name, ft_arity = arity, ft_priority = prio, ft_type = type, ft_pos = pos, ft_specials = specials, ft_type_ptr = var_ptr } +backslash :== '\\' diff --git a/frontend/syntax.icl b/frontend/syntax.icl index 2fb4020..53833e9 100644 --- a/frontend/syntax.icl +++ b/frontend/syntax.icl @@ -252,7 +252,7 @@ cNameLocationDependent :== True :: Import from_symbol = { import_module :: !Ident , import_symbols :: ![from_symbol] - , import_file_position:: !(!FileName, !Int) // for error messages + , import_file_position:: !Position // for error messages } :: ParsedImport :== Import ImportDeclaration @@ -418,7 +418,7 @@ cIsALocalVar :== False :: AP_Kind = APK_Constructor !Index | APK_Macro -:: VarInfo = VI_Empty | VI_Type !AType | VI_Occurrence !Occurrence | VI_UsedVar !Ident | +:: VarInfo = VI_Empty |VI_Type !AType !(Optional CoercionPosition) | VI_Occurrence !Occurrence | VI_UsedVar !Ident | VI_Expression !Expression | VI_Variable !Ident !VarInfoPtr | VI_LiftedVariable !VarInfoPtr | VI_Count !Int /* the reference count of a variable */ !Bool /* true if the variable is global, false otherwise */ | VI_AccVar !ConsClass !ArgumentPosition /* used during fusion to determine accumulating parameters of functions */ | @@ -909,6 +909,7 @@ cIsArrayGenerator :== False { qual_generators :: ![Generator] , qual_filter :: !Optional ParsedExpr , qual_position :: !LineAndColumn + , qual_filename :: !FileName } :: Sequence = SQ_FromThen ParsedExpr ParsedExpr @@ -1050,6 +1051,10 @@ cIsNotStrict :== False | PreDefPos Ident | NoPos +:: CoercionPosition + = CP_Expression !Expression + | CP_FunArg !Ident !Int // Function symbol, argument position (>=1) + :: IdentPos = { ip_ident :: !Ident , ip_line :: !Int @@ -1818,3 +1823,4 @@ MakeDefinedSymbol ident index arity :== { ds_ident = ident, ds_arity = arity, ds MakeNewFunctionType name arity prio type pos specials var_ptr :== { ft_symb = name, ft_arity = arity, ft_priority = prio, ft_type = type, ft_pos = pos, ft_specials = specials, ft_type_ptr = var_ptr } +backslash :== '\\' diff --git a/frontend/type.icl b/frontend/type.icl index ed3a10b..48e6de6 100644 --- a/frontend/type.icl +++ b/frontend/type.icl @@ -161,8 +161,9 @@ where cannotUnify t1 t2 position err # err = errorHeading "Type error" err format = { form_properties = cNoProperties, form_attr_position = No } - = { err & ea_file = err.ea_file <<< " cannot unify " <:: (format, t1) <<< " with " <:: (format, t2) <<< " near " <<< position <<< '\n' } - +// MW3 was: = { err & ea_file = err.ea_file <<< " cannot unify " <:: (format, t1) <<< " with " <:: (format, t2) <<< " near " <<< position <<< '\n' } + = { err & ea_file = err.ea_file <<< optionalFrontPosition position <<< " cannot unify " <:: (format, t1) + <<< " with " <:: (format, t2) <<< position <<< '\n' } /* simplifyType ta=:(type :@: type_args) @@ -813,7 +814,8 @@ where ts = { ts & ts_var_heap = ts_var_heap } /* JVG: changed to reduce allocation because the case is polymorphic and lazy in req and ts: */ = (case var_info of - VI_Type type +// MW3 was: VI_Type type + VI_Type type _ -> type _ -> abort ("requirements BoundVar" ---> (var_name <<- var_info)) @@ -830,21 +832,26 @@ where requirements ti {app_symb,app_args,app_info_ptr} (reqs=:{req_cons_variables, req_attr_coercions}, ts) # (tst=:{tst_attr_env,tst_args,tst_result,tst_context}, cons_variables, specials, ts) = getSymbolType ti app_symb ts reqs = { reqs & req_attr_coercions = tst_attr_env ++ req_attr_coercions, req_cons_variables = [cons_variables : req_cons_variables] } - (reqs, ts) = requirements_of_args ti app_args tst_args (reqs, ts) + (reqs, ts) = requirements_of_args ti app_symb.symb_name 1 app_args tst_args (reqs, ts) | isEmpty tst_context = (tst_result, No, (reqs, ts)) = (tst_result, No, ({ reqs & req_overloaded_calls = [app_info_ptr : reqs.req_overloaded_calls ]}, { ts & ts_expr_heap = ts.ts_expr_heap <:= (app_info_ptr, EI_Overloaded { oc_symbol = app_symb, oc_context = tst_context, oc_specials = specials })})) where - requirements_of_args :: !TypeInput ![Expression] ![AType] !(!u:Requirements, !*TypeState) -> (!u:Requirements, !*TypeState) - requirements_of_args ti [] [] reqs_ts +// MW3 was: requirements_of_args :: !TypeInput ![Expression] ![AType] !(!u:Requirements, !*TypeState) -> (!u:Requirements, !*TypeState) + requirements_of_args :: !TypeInput !Ident !Int ![Expression] ![AType] !(!u:Requirements, !*TypeState) -> (!u:Requirements, !*TypeState) +// MW3 was: requirements_of_args ti [] [] reqs_ts + requirements_of_args ti _ _ [] [] reqs_ts = reqs_ts - requirements_of_args ti [expr:exprs] [lt:lts] reqs_ts +// MW3 was: requirements_of_args ti [expr:exprs] [lt:lts] reqs_ts + requirements_of_args ti fun_ident arg_nr [expr:exprs] [lt:lts] reqs_ts # (e_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr reqs_ts - req_type_coercions = [{ tc_demanded = lt, tc_offered = e_type, tc_position = { cp_expression = expr }, tc_coercible = True } : reqs.req_type_coercions ] +// MW3 was: req_type_coercions = [{ tc_demanded = lt, tc_offered = e_type, tc_position = { cp_expression = expr }, tc_coercible = True } : reqs.req_type_coercions ] + req_type_coercions = [{ tc_demanded = lt, tc_offered = e_type, tc_position = CP_FunArg fun_ident arg_nr, tc_coercible = True } : reqs.req_type_coercions ] ts_expr_heap = storeAttribute opt_expr_ptr lt.at_attribute ts.ts_expr_heap - = requirements_of_args ti exprs lts ({ reqs & req_type_coercions = req_type_coercions}, { ts & ts_expr_heap = ts_expr_heap }) +// MW3 was: = requirements_of_args ti exprs lts ({ reqs & req_type_coercions = req_type_coercions}, { ts & ts_expr_heap = ts_expr_heap }) + = requirements_of_args ti fun_ident (arg_nr+1) exprs lts ({ reqs & req_type_coercions = req_type_coercions}, { ts & ts_expr_heap = ts_expr_heap }) instance requirements Case where @@ -862,30 +869,39 @@ where # (cons_types, result_type, new_attr_env, ts) = freshAlgebraicType alg_type patterns ti_common_defs ts (used_cons_types, (reqs, ts)) = requirements_of_algebraic_patterns ti patterns cons_types goal_type [] (reqs, ts) ts_expr_heap = storeAttribute opt_pattern_ptr result_type.at_attribute ts.ts_expr_heap - = (reverse used_cons_types, ({ reqs & req_type_coercions = [{tc_demanded = result_type,tc_offered = pattern_type, tc_position = { cp_expression = match_expr }, + (position, ts_var_heap) = getPositionOfExpr match_expr ts.ts_var_heap // MW3++ +// MW3 was: = (reverse used_cons_types, ({ reqs & req_type_coercions = [{tc_demanded = result_type,tc_offered = pattern_type, tc_position = { cp_expression = match_expr }, + = (reverse used_cons_types, ({ reqs & req_type_coercions = [{tc_demanded = result_type,tc_offered = pattern_type, tc_position = position, tc_coercible = True} : reqs.req_type_coercions], - req_attr_coercions = new_attr_env ++ reqs.req_attr_coercions }, { ts & ts_expr_heap = ts_expr_heap })) +// MW3 was: req_attr_coercions = new_attr_env ++ reqs.req_attr_coercions }, { ts & ts_expr_heap = ts_expr_heap })) + req_attr_coercions = new_attr_env ++ reqs.req_attr_coercions }, { ts & ts_expr_heap = ts_expr_heap, ts_var_heap = ts_var_heap })) requirements_of_guarded_expressions ti (BasicPatterns bas_type patterns) match_expr pattern_type opt_pattern_ptr goal_type (reqs, ts) # (attr_bas_type, ts) = attributedBasicType bas_type ts (reqs, ts) = requirements_of_basic_patterns ti patterns goal_type (reqs, ts) ts_expr_heap = storeAttribute opt_pattern_ptr attr_bas_type.at_attribute ts.ts_expr_heap - = ([], ({ reqs & req_type_coercions = [{tc_demanded = attr_bas_type,tc_offered = pattern_type, tc_position = { cp_expression = match_expr }, tc_coercible = True} : +// MW3 was: = ([], ({ reqs & req_type_coercions = [{tc_demanded = attr_bas_type,tc_offered = pattern_type, tc_position = { cp_expression = match_expr }, tc_coercible = True} : + = ([], ({ reqs & req_type_coercions = [{tc_demanded = attr_bas_type,tc_offered = pattern_type, tc_position = CP_Expression match_expr, tc_coercible = True} : reqs.req_type_coercions]}, { ts & ts_expr_heap = ts_expr_heap })) requirements_of_guarded_expressions ti (DynamicPatterns dynamic_patterns) match_expr pattern_type opt_pattern_ptr goal_type reqs_ts # dyn_type = { at_type = TB BT_Dynamic, at_attribute = TA_Multi, at_annotation = AN_None } (used_dyn_types, (reqs, ts)) = requirements_of_dynamic_patterns ti goal_type dynamic_patterns [] reqs_ts ts_expr_heap = storeAttribute opt_pattern_ptr TA_Multi ts.ts_expr_heap - = (reverse used_dyn_types, ({ reqs & req_type_coercions = [{tc_demanded = dyn_type, tc_offered = pattern_type, tc_position = { cp_expression = match_expr }, tc_coercible = True} : +// MW3 was: = (reverse used_dyn_types, ({ reqs & req_type_coercions = [{tc_demanded = dyn_type, tc_offered = pattern_type, tc_position = { cp_expression = match_expr }, tc_coercible = True} : + = (reverse used_dyn_types, ({ reqs & req_type_coercions = [{tc_demanded = dyn_type, tc_offered = pattern_type, tc_position = CP_Expression match_expr, tc_coercible = True} : reqs.req_type_coercions] }, { ts & ts_expr_heap = ts_expr_heap })) requirements_of_algebraic_patterns ti [] cons_types goal_type used_cons_types reqs_ts = (used_cons_types, reqs_ts) - requirements_of_algebraic_patterns ti=:{ti_common_defs}[{ap_vars, ap_expr }:gs] [ cons_arg_types : cons_types] goal_type used_cons_types (reqs, ts) - # (res_type, opt_expr_ptr, (reqs, ts)) = requirements ti ap_expr (reqs, { ts & ts_var_heap = makeBase ap_vars cons_arg_types ts.ts_var_heap}) +// MW3 was: requirements_of_algebraic_patterns ti=:{ti_common_defs}[{ap_vars, ap_expr }:gs] [ cons_arg_types : cons_types] goal_type used_cons_types (reqs, ts) +// MW3 was: # (res_type, opt_expr_ptr, (reqs, ts)) = requirements ti ap_expr (reqs, { ts & ts_var_heap = makeBase ap_vars cons_arg_types ts.ts_var_heap}) + requirements_of_algebraic_patterns ti=:{ti_common_defs} [{ap_symbol, ap_vars, ap_expr }:gs] [ cons_arg_types : cons_types] goal_type used_cons_types (reqs, ts) + # (res_type, opt_expr_ptr, (reqs, ts)) + = requirements ti ap_expr (reqs, { ts & ts_var_heap = makeBase ap_symbol.glob_object.ds_ident 1 ap_vars cons_arg_types ts.ts_var_heap}) ts_expr_heap = storeAttribute opt_expr_ptr res_type.at_attribute ts.ts_expr_heap = requirements_of_algebraic_patterns ti gs cons_types goal_type [ cons_arg_types : used_cons_types ] - ({ reqs & req_type_coercions = [ { tc_demanded = goal_type, tc_offered = res_type, tc_position = { cp_expression = ap_expr }, tc_coercible = True } : reqs.req_type_coercions] }, +// MW3 was: ({ reqs & req_type_coercions = [ { tc_demanded = goal_type, tc_offered = res_type, tc_position = { cp_expression = ap_expr }, tc_coercible = True } : reqs.req_type_coercions] }, + ({ reqs & req_type_coercions = [ { tc_demanded = goal_type, tc_offered = res_type, tc_position = CP_Expression ap_expr, tc_coercible = True } : reqs.req_type_coercions] }, { ts & ts_expr_heap = ts_expr_heap }) requirements_of_basic_patterns _ [] goal_type reqs_ts @@ -894,15 +910,18 @@ where # (res_type, opt_expr_ptr, (reqs, ts)) = requirements ti bp_expr reqs_ts ts_expr_heap = storeAttribute opt_expr_ptr res_type.at_attribute ts.ts_expr_heap = requirements_of_basic_patterns ti gs goal_type - ({ reqs & req_type_coercions = [ { tc_demanded = goal_type, tc_offered = res_type, tc_position = { cp_expression = bp_expr }, tc_coercible = True } : reqs.req_type_coercions] }, +// MW3 was: ({ reqs & req_type_coercions = [ { tc_demanded = goal_type, tc_offered = res_type, tc_position = { cp_expression = bp_expr }, tc_coercible = True } : reqs.req_type_coercions] }, + ({ reqs & req_type_coercions = [ { tc_demanded = goal_type, tc_offered = res_type, tc_position = CP_Expression bp_expr, tc_coercible = True } : reqs.req_type_coercions] }, { ts & ts_expr_heap = ts_expr_heap }) requirements_of_dynamic_patterns ti goal_type [{dp_var={fv_info_ptr},dp_type,dp_rhs} : dps] used_dyn_types (reqs, ts=:{ts_expr_heap, ts_var_heap}) # (EI_TempDynamicPattern _ _ _ _ dyn_type dyn_context dyn_expr_ptr type_code_symbol, ts_expr_heap) = readPtr dp_type ts_expr_heap - ts_var_heap = ts_var_heap <:= (fv_info_ptr, VI_Type dyn_type) +// MW3 was: ts_var_heap = ts_var_heap <:= (fv_info_ptr, VI_Type dyn_type) + ts_var_heap = ts_var_heap <:= (fv_info_ptr, VI_Type dyn_type No) (dp_rhs_type, opt_expr_ptr, (reqs, ts)) = requirements ti dp_rhs (reqs, { ts & ts_expr_heap = ts_expr_heap, ts_var_heap = ts_var_heap }) ts_expr_heap = storeAttribute opt_expr_ptr dp_rhs_type.at_attribute ts.ts_expr_heap - type_coercion = { tc_demanded = goal_type, tc_offered = dp_rhs_type, tc_position = { cp_expression = dp_rhs }, tc_coercible = True } +// MW3 was: type_coercion = { tc_demanded = goal_type, tc_offered = dp_rhs_type, tc_position = { cp_expression = dp_rhs }, tc_coercible = True } + type_coercion = { tc_demanded = goal_type, tc_offered = dp_rhs_type, tc_position = CP_Expression dp_rhs, tc_coercible = True } | isEmpty dyn_context # reqs = {reqs & req_type_coercions = [ type_coercion : reqs.req_type_coercions]} = requirements_of_dynamic_patterns ti goal_type dps [ [dyn_type] : used_dyn_types ] (reqs, { ts & ts_expr_heap = ts_expr_heap }) @@ -916,7 +935,8 @@ where requirements_of_default ti (Yes expr) goal_type reqs_ts # (res_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr reqs_ts ts_expr_heap = storeAttribute opt_expr_ptr res_type.at_attribute ts.ts_expr_heap - = ({ reqs & req_type_coercions = [ { tc_demanded = goal_type, tc_offered = res_type, tc_position = { cp_expression = expr }, tc_coercible = True } : reqs.req_type_coercions] }, +// MW3 was: = ({ reqs & req_type_coercions = [ { tc_demanded = goal_type, tc_offered = res_type, tc_position = { cp_expression = expr }, tc_coercible = True } : reqs.req_type_coercions] }, + = ({ reqs & req_type_coercions = [ { tc_demanded = goal_type, tc_offered = res_type, tc_position = CP_Expression expr, tc_coercible = True } : reqs.req_type_coercions] }, { ts & ts_expr_heap = ts_expr_heap }) requirements_of_default ti No goal_type reqs_ts = reqs_ts @@ -933,9 +953,15 @@ where = ( res_type, opt_expr_ptr, ({ reqs & req_case_and_let_exprs = [let_info_ptr : reqs.req_case_and_let_exprs]},{ ts & ts_expr_heap = ts_expr_heap })) where +/* MW3 was make_base [{bind_dst={fv_info_ptr}}:bs] var_types ts=:{ts_var_heap} # (v, ts) = freshAttributedVariable ts = make_base bs [v:var_types] { ts & ts_var_heap = writePtr fv_info_ptr (VI_Type v) ts.ts_var_heap } +*/ + make_base [{bind_src, bind_dst={fv_name, fv_info_ptr}}:bs] var_types ts=:{ts_var_heap} + # (v, ts) = freshAttributedVariable ts + optional_position = if (is_rare_name fv_name) (Yes (CP_Expression bind_src)) No + = make_base bs [v:var_types] { ts & ts_var_heap = writePtr fv_info_ptr (VI_Type v optional_position) ts.ts_var_heap } make_base [] var_types ts = (var_types, ts) @@ -944,7 +970,8 @@ where requirements_of_binds ti [{bind_src}:bs] [b_type:bts] reqs_ts # (exp_type, opt_expr_ptr, (reqs, ts)) = requirements ti bind_src reqs_ts ts_expr_heap = storeAttribute opt_expr_ptr b_type.at_attribute ts.ts_expr_heap - req_type_coercions = [ { tc_demanded = b_type, tc_offered = exp_type, tc_position = { cp_expression = bind_src }, tc_coercible = True } +// MW3 was: req_type_coercions = [ { tc_demanded = b_type, tc_offered = exp_type, tc_position = { cp_expression = bind_src }, tc_coercible = True } + req_type_coercions = [ { tc_demanded = b_type, tc_offered = exp_type, tc_position = CP_Expression bind_src, tc_coercible = True } : reqs.req_type_coercions ] = requirements_of_binds ti bs bts ({ reqs & req_type_coercions = req_type_coercions }, { ts & ts_expr_heap = ts_expr_heap }) @@ -954,7 +981,8 @@ where # (EI_TempDynamicType _ dyn_type dyn_context dyn_expr_ptr type_code_symbol, ts_expr_heap) = readPtr dyn_info_ptr ts_expr_heap (dyn_expr_type, opt_expr_ptr, (reqs, ts)) = requirements ti dyn_expr (reqs, { ts & ts_expr_heap = ts_expr_heap }) ts_expr_heap = storeAttribute opt_expr_ptr dyn_expr_type.at_attribute ts.ts_expr_heap - type_coercion = { tc_demanded = dyn_type, tc_offered = dyn_expr_type, tc_position = { cp_expression = dyn_expr }, tc_coercible = True } +// MW3 was: type_coercion = { tc_demanded = dyn_type, tc_offered = dyn_expr_type, tc_position = { cp_expression = dyn_expr }, tc_coercible = True } + type_coercion = { tc_demanded = dyn_type, tc_offered = dyn_expr_type, tc_position = CP_Expression dyn_expr, tc_coercible = True } | isEmpty dyn_context = ({ at_type = TB BT_Dynamic, at_attribute = TA_Multi, at_annotation = AN_None }, No, ({reqs & req_type_coercions = [ type_coercion : reqs.req_type_coercions]}, @@ -977,7 +1005,8 @@ where (alpha, ts) = freshAttributedVariable ts (fun_type, req_type_coercions, ts) = apply_type rev_off_arg_types alpha reqs.req_type_coercions function ts ts_expr_heap = storeAttribute opt_fun_expr_ptr fun_type.at_attribute ts.ts_expr_heap - = (alpha, No, ({ reqs & req_type_coercions = [{ tc_demanded = fun_type, tc_offered = off_fun_type, tc_position = { cp_expression = function }, tc_coercible = True } : req_type_coercions ]}, { ts & ts_expr_heap = ts_expr_heap })) +// MW3 was: = (alpha, No, ({ reqs & req_type_coercions = [{ tc_demanded = fun_type, tc_offered = off_fun_type, tc_position = { cp_expression = function }, tc_coercible = True } : req_type_coercions ]}, { ts & ts_expr_heap = ts_expr_heap })) + = (alpha, No, ({ reqs & req_type_coercions = [{ tc_demanded = fun_type, tc_offered = off_fun_type, tc_position = CP_Expression function, tc_coercible = True } : req_type_coercions ]}, { ts & ts_expr_heap = ts_expr_heap })) where requirements_of_list _ [] rev_list_types reqs_ts = (rev_list_types, reqs_ts) @@ -997,7 +1026,8 @@ where determine_demanded_type type (Yes expr_ptr) type_coercions expr ts # (dem_type, ts) = freshAttributedVariable ts ts_expr_heap = writePtr expr_ptr (EI_Attribute (toInt dem_type.at_attribute)) ts.ts_expr_heap - = (dem_type, [ { tc_demanded = dem_type, tc_offered = type, tc_position = { cp_expression = expr }, tc_coercible = True } : type_coercions ], +// MW3 was: = (dem_type, [ { tc_demanded = dem_type, tc_offered = type, tc_position = { cp_expression = expr }, tc_coercible = True } : type_coercions ], + = (dem_type, [ { tc_demanded = dem_type, tc_offered = type, tc_position = CP_Expression expr, tc_coercible = True } : type_coercions ], { ts & ts_expr_heap = ts_expr_heap }) determine_demanded_type type No type_coercions expr ts = (type, type_coercions, ts) @@ -1020,8 +1050,10 @@ where tuple_type = MakeTypeSymbIdent { glob_object = ds_index, glob_module = glob_module } ds_ident ds_arity non_unique_type_var = { at_attribute = TA_Multi, at_annotation = AN_None, at_type = TempV ts.ts_var_store } req_type_coercions - = [ { tc_demanded = non_unique_type_var, tc_offered = result_type, tc_position = { cp_expression = expr }, tc_coercible = False }, - { tc_demanded = var, tc_offered = expr_type, tc_position = { cp_expression = expr }, tc_coercible = True } : +// MW3 was: = [ { tc_demanded = non_unique_type_var, tc_offered = result_type, tc_position = { cp_expression = expr }, tc_coercible = False }, +// MW3 was: { tc_demanded = var, tc_offered = expr_type, tc_position = { cp_expression = expr }, tc_coercible = True } : + = [ { tc_demanded = non_unique_type_var, tc_offered = result_type, tc_position = CP_Expression expr, tc_coercible = False }, + { tc_demanded = var, tc_offered = expr_type, tc_position = CP_Expression expr, tc_coercible = True } : reqs.req_type_coercions] result_type = { at_type = TA tuple_type [non_unique_type_var,var], at_attribute = TA_Unique, at_annotation = AN_None } -> (result_type, No, ({ reqs & req_type_coercions = req_type_coercions }, @@ -1040,7 +1072,8 @@ where (expression_type, opt_expr_ptr, reqs_ts) = requirements ti expression (reqs, ts) (reqs, ts) = requirements_of_fields ti expression expressions rhs.tst_args lhs.tst_args reqs_ts ts = { ts & ts_expr_heap = storeAttribute opt_expr_ptr lhs.tst_result.at_attribute ts.ts_expr_heap } - coercion = { tc_demanded = lhs.tst_result, tc_offered = expression_type, tc_position = { cp_expression = expression }, tc_coercible = True } +// MW3 was: coercion = { tc_demanded = lhs.tst_result, tc_offered = expression_type, tc_position = { cp_expression = expression }, tc_coercible = True } + coercion = { tc_demanded = lhs.tst_result, tc_offered = expression_type, tc_position = CP_Expression expression, tc_coercible = True } = (rhs.tst_result, No, ({ reqs & req_attr_coercions = rhs.tst_attr_env ++ lhs.tst_attr_env ++ reqs.req_attr_coercions, req_type_coercions = [ coercion : reqs.req_type_coercions ]}, ts)) where @@ -1052,20 +1085,25 @@ where requirements_of_field ti expression {bind_src=NoBind expr_ptr} dem_field_type off_field_type (reqs=:{req_type_coercions}, ts) # ts = { ts & ts_expr_heap = ts.ts_expr_heap <:= (expr_ptr, EI_Attribute (toInt dem_field_type.at_attribute)) } - coercion = { tc_demanded = dem_field_type, tc_offered = off_field_type, tc_position = { cp_expression = expression }, tc_coercible = True } +// MW3 was: coercion = { tc_demanded = dem_field_type, tc_offered = off_field_type, tc_position = { cp_expression = expression }, tc_coercible = True } + coercion = { tc_demanded = dem_field_type, tc_offered = off_field_type, tc_position = CP_Expression expression, tc_coercible = True } = ({ reqs & req_type_coercions = [ coercion : req_type_coercions ]}, ts) requirements_of_field ti _ {bind_src} dem_field_type _ reqs_ts # (expr_type, opt_expr_ptr, (reqs, ts)) = requirements ti bind_src reqs_ts ts = { ts & ts_expr_heap = storeAttribute opt_expr_ptr dem_field_type.at_attribute ts.ts_expr_heap } - coercion = { tc_demanded = dem_field_type, tc_offered = expr_type, tc_position = { cp_expression = bind_src }, tc_coercible = True } +// MW3 was: coercion = { tc_demanded = dem_field_type, tc_offered = expr_type, tc_position = { cp_expression = bind_src }, tc_coercible = True } + coercion = { tc_demanded = dem_field_type, tc_offered = expr_type, tc_position = CP_Expression bind_src, tc_coercible = True } = ({ reqs & req_type_coercions = [ coercion : reqs.req_type_coercions ]}, ts) requirements ti (TupleSelect tuple_symbol arg_nr expr) (reqs=:{req_attr_coercions}, ts) # ({tst_args = [argtype:_], tst_result, tst_attr_env}, ts) = standardTupleSelectorType tuple_symbol arg_nr ti ts (e_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr ({ reqs & req_attr_coercions = tst_attr_env ++ req_attr_coercions }, ts) - req_type_coercions = [{ tc_demanded = argtype, tc_offered = e_type, tc_position = { cp_expression = expr }, tc_coercible = True } : reqs.req_type_coercions ] +// MW3 was: req_type_coercions = [{ tc_demanded = argtype, tc_offered = e_type, tc_position = { cp_expression = expr }, tc_coercible = True } : reqs.req_type_coercions ] + (position, ts_var_heap) = getPositionOfExpr expr ts.ts_var_heap // MW3++ + req_type_coercions = [{ tc_demanded = argtype, tc_offered = e_type, tc_position = position, tc_coercible = True } : reqs.req_type_coercions ] 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 })) +// MW3 was: = (tst_result, No, ({ reqs & req_type_coercions = req_type_coercions }, { ts & ts_expr_heap = ts_expr_heap })) + = (tst_result, No, ({ reqs & req_type_coercions = req_type_coercions }, { ts & ts_expr_heap = ts_expr_heap, ts_var_heap = ts_var_heap })) requirements _ (BasicExpr basic_val basic_type) (reqs, ts) @@ -1077,7 +1115,8 @@ where # ({tst_result,tst_args,tst_attr_env}, ts) = standardLhsConstructorType ds_index glob_module ds_arity ti ts (e_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr (reqs, ts) reqs = { reqs & req_attr_coercions = tst_attr_env ++ reqs.req_attr_coercions, - req_type_coercions = [{ tc_demanded = tst_result, tc_offered = e_type, tc_position = { cp_expression = expr }, tc_coercible = True } : reqs.req_type_coercions ] } +// MW3 was: req_type_coercions = [{ tc_demanded = tst_result, tc_offered = e_type, tc_position = { cp_expression = expr }, tc_coercible = True } : reqs.req_type_coercions ] } + req_type_coercions = [{ tc_demanded = tst_result, tc_offered = e_type, tc_position = CP_Expression expr, tc_coercible = True } : reqs.req_type_coercions ] } ts = { ts & ts_expr_heap = storeAttribute opt_expr_ptr tst_result.at_attribute ts.ts_expr_heap } = case opt_tuple_type of Yes {glob_object={ds_ident,ds_index,ds_arity}, glob_module} @@ -1120,7 +1159,8 @@ where */ requirementsOfSelector ti _ expr (RecordSelection field _) tc_coercible sel_expr_type sel_expr (reqs, ts ) # ({tst_args, tst_result, tst_attr_env}, ts) = standardFieldSelectorType field ti ts - req_type_coercions = [{ tc_demanded = hd tst_args, tc_offered = sel_expr_type, tc_position = { cp_expression = sel_expr }, tc_coercible = tc_coercible } : +// MW3 was: req_type_coercions = [{ tc_demanded = hd tst_args, tc_offered = sel_expr_type, tc_position = { cp_expression = sel_expr }, tc_coercible = tc_coercible } : + 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 ] = (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 sel_expr_type sel_expr (reqs, ts) @@ -1130,8 +1170,10 @@ requirementsOfSelector ti opt_expr expr (ArraySelection {glob_object = {ds_ident reqs ={ reqs & req_attr_coercions = tst_attr_env ++ reqs.req_attr_coercions, req_cons_variables = [ cons_variables : reqs.req_cons_variables ]} (index_type, opt_expr_ptr, (reqs, ts)) = requirements ti index_expr (reqs, ts) ts_expr_heap = storeAttribute opt_expr_ptr dem_index_type.at_attribute ts.ts_expr_heap - reqs = { reqs & req_type_coercions = [{ tc_demanded = dem_index_type, tc_offered = index_type, tc_position = { cp_expression = expr }, tc_coercible = True }, - { tc_demanded = dem_array_type, tc_offered = sel_expr_type, tc_position = { cp_expression = sel_expr }, tc_coercible = tc_coercible } : reqs.req_type_coercions ]} +// MW3 was: reqs = { reqs & req_type_coercions = [{ tc_demanded = dem_index_type, tc_offered = index_type, tc_position = { cp_expression = expr }, tc_coercible = True }, +// MW3 was: { tc_demanded = dem_array_type, tc_offered = sel_expr_type, tc_position = { cp_expression = sel_expr }, tc_coercible = tc_coercible } : reqs.req_type_coercions ]} + reqs = { reqs & req_type_coercions = [{ tc_demanded = dem_index_type, tc_offered = index_type, tc_position = CP_Expression expr, tc_coercible = True }, + { tc_demanded = dem_array_type, tc_offered = sel_expr_type, tc_position = CP_Expression sel_expr, tc_coercible = tc_coercible } : reqs.req_type_coercions ]} (reqs, ts) = requirements_of_update ti opt_expr rest_type (reqs, { ts & ts_expr_heap = ts_expr_heap }) | isEmpty tst_context = (tst_result, (reqs, ts)) @@ -1149,11 +1191,20 @@ where # (elem_expr_type, opt_elem_expr_ptr, (reqs, ts)) = requirements ti elem_expr reqs_ts ts = { ts & ts_expr_heap = storeAttribute opt_elem_expr_ptr elem_type.at_attribute ts.ts_expr_heap } reqs = { reqs & req_type_coercions = [{ tc_demanded = elem_type, tc_offered = elem_expr_type, - tc_position = { cp_expression = elem_expr }, tc_coercible = True } : reqs.req_type_coercions ]} +// MW3 was: tc_position = { cp_expression = elem_expr }, tc_coercible = True } : reqs.req_type_coercions ]} + tc_position = CP_Expression elem_expr, tc_coercible = True } : reqs.req_type_coercions ]} = (reqs, ts) +/* MW3 was makeBase vars types ts_var_heap = fold2St (\ {fv_info_ptr} type var_heap -> var_heap <:= (fv_info_ptr, VI_Type type)) vars types ts_var_heap +*/ +makeBase _ _ [] [] ts_var_heap + = ts_var_heap +makeBase fun_or_cons_ident arg_nr [{fv_name, fv_info_ptr}:vars] [type:types] ts_var_heap + # optional_position = if (is_rare_name fv_name) (Yes (CP_FunArg fun_or_cons_ident arg_nr)) No + ts_var_heap = ts_var_heap <:= (fv_info_ptr, VI_Type type optional_position) + = makeBase fun_or_cons_ident (arg_nr+1) vars types ts_var_heap attributedBasicType (BT_String string_type) ts=:{ts_attr_store} = ({ at_annotation = AN_None, at_attribute = TA_TempVar ts_attr_store, at_type = string_type}, {ts & ts_attr_store = inc ts_attr_store}) @@ -1720,13 +1771,15 @@ where (type, ts_fun_env) = ts_fun_env![fun_index] {fun_symb,fun_arity,fun_body=TransformedBody {tb_args,tb_rhs},fun_pos, fun_info, fun_type} = fd temp_fun_type = type_of type - ts_var_heap = makeBase tb_args temp_fun_type.tst_args ts_var_heap +// MW3 was: ts_var_heap = makeBase tb_args temp_fun_type.tst_args ts_var_heap + ts_var_heap = makeBase fun_symb 1 tb_args temp_fun_type.tst_args ts_var_heap fe_location = newPosition fun_symb fun_pos ts_error = setErrorAdmin fe_location ts_error reqs = { req_overloaded_calls = [], req_type_coercions = [], req_attr_coercions = [], req_case_and_let_exprs = [], req_cons_variables = cons_variables } ( rhs_type, rhs_expr_ptr, (rhs_reqs, ts)) = requirements ti tb_rhs (reqs, { ts & ts_var_heap = ts_var_heap, ts_expr_heap = ts_expr_heap, ts_error = ts_error, ts_fun_env = ts_fun_env }) - req_type_coercions = [{tc_demanded = temp_fun_type.tst_result,tc_offered = rhs_type, tc_position = {cp_expression = tb_rhs }, tc_coercible = True} : +// MW3 was: req_type_coercions = [{tc_demanded = temp_fun_type.tst_result,tc_offered = rhs_type, tc_position = {cp_expression = tb_rhs }, tc_coercible = True} : + req_type_coercions = [{tc_demanded = temp_fun_type.tst_result,tc_offered = rhs_type, tc_position = CP_Expression tb_rhs, tc_coercible = True} : rhs_reqs.req_type_coercions ] ts_expr_heap = storeAttribute rhs_expr_ptr temp_fun_type.tst_result.at_attribute ts.ts_expr_heap = ({fe_location = fe_location, fe_context = if (has_option fun_type) (Yes temp_fun_type.tst_context) No, fe_index = fun_index, @@ -1802,6 +1855,20 @@ where CheckedType _ -> ts +is_rare_name {id_name} + = id_name.[0]=='_' + +getPositionOfExpr expr=:(Var {var_info_ptr}) var_heap + # (VI_Type _ opt_position, var_heap) = readPtr var_info_ptr var_heap + = (case opt_position of + Yes position + -> position + No + -> CP_Expression expr, + var_heap) +getPositionOfExpr expr var_heap + = (CP_Expression expr, var_heap) + instance <<< AttrCoercion where (<<<) file {ac_demanded,ac_offered} = file <<< "AttrCoercion: " <<< ac_demanded <<< '~' <<< ac_offered diff --git a/frontend/typesupport.dcl b/frontend/typesupport.dcl index 739470b..0155406 100644 --- a/frontend/typesupport.dcl +++ b/frontend/typesupport.dcl @@ -65,3 +65,5 @@ class substitute a :: !a !*TypeHeaps -> (!a, !*TypeHeaps) instance substitute AType, Type, TypeContext, AttrInequality, CaseType, [a] | substitute a instance <<< TempSymbolType + +optionalFrontPosition :: !CoercionPosition -> String // MW3++ diff --git a/frontend/typesupport.icl b/frontend/typesupport.icl index 4bec518..a474625 100644 --- a/frontend/typesupport.icl +++ b/frontend/typesupport.icl @@ -1006,3 +1006,10 @@ where = file <<< tst_result <<< " | " <<< tst_context <<< " [" <<< tst_attr_env <<< ']' = file <<< tst_args <<< " -> " <<< tst_result <<< " | " <<< tst_context <<< " [" <<< tst_attr_env <<< ']' +// MW3.. +optionalFrontPosition :: !CoercionPosition -> String +optionalFrontPosition (CP_Expression _) + = "" +optionalFrontPosition (CP_FunArg {id_name} arg_nr) + = "\"argument "+++toString arg_nr+++" of "+++id_name+++"\"" +// ..MW3 diff --git a/frontend/unitype.dcl b/frontend/unitype.dcl index 197dec5..cdb79ef 100644 --- a/frontend/unitype.dcl +++ b/frontend/unitype.dcl @@ -3,9 +3,11 @@ definition module unitype import StdEnv import syntax, analunitypes +/* MW3 moved to syntax: :: CoercionPosition = { cp_expression :: !Expression } +*/ AttrUni :== 0 AttrMulti :== 1 diff --git a/frontend/unitype.icl b/frontend/unitype.icl index d6fdd1a..7c94722 100644 --- a/frontend/unitype.icl +++ b/frontend/unitype.icl @@ -6,9 +6,11 @@ import syntax, analunitypes, type, utilities, checktypes, RWSDebug import cheat +/* MW3 moved to syntax: :: CoercionPosition = { cp_expression :: !Expression } +*/ AttrUni :== 0 AttrMulti :== 1 @@ -61,7 +63,10 @@ determineAttributeCoercions off_type dem_type coercible position subst coercions (crc_coercions, copy_crc_coercions) = uniqueCopy crc_coercions format = { form_properties = cMarkAttribute, form_attr_position = Yes (reverse positions, copy_crc_coercions) } - ea_file = error.ea_file <<< " attribute at indicated position could not be coerced " <:: (format, exp_off_type) <<< '\n' +// MW3 was: ea_file = error.ea_file <<< " attribute at indicated position could not be coerced " <:: (format, exp_off_type) <<< '\n' + ea_file = error.ea_file <<< optionalFrontPosition position + <<< " attribute at indicated position could not be coerced " <:: (format, exp_off_type) + <<< position <<< '\n' -> (subst, crc_coercions, crc_td_infos, crc_type_heaps, { error & ea_file = ea_file }) @@ -77,6 +82,7 @@ determineAttributeCoercions off_type dem_type coercible position subst coercions -> undef */ + NotChecked :== -1 DummyAttrNumber :== -1 :: AttributeGroups :== {! [Int]} @@ -720,10 +726,15 @@ where (<<<) file CT_NonUnique = file <<< "CT_NonUnique" (<<<) file CT_Empty = file <<< "##" +/* MW3 was: instance <<< CoercionPosition where (<<<) file {cp_expression} = show_expression file cp_expression - +*/ +instance <<< CoercionPosition +where + (<<<) file (CP_FunArg fun_ident arg_nr) = file + (<<<) file (CP_Expression expression) = show_expression (file <<< " near ") expression where show_expression file (Var {var_name}) = file <<< var_name |