diff options
Diffstat (limited to 'frontend/postparse.icl')
| -rw-r--r-- | frontend/postparse.icl | 479 |
1 files changed, 233 insertions, 246 deletions
diff --git a/frontend/postparse.icl b/frontend/postparse.icl index c401606..19bfb35 100644 --- a/frontend/postparse.icl +++ b/frontend/postparse.icl @@ -8,6 +8,15 @@ import RWSDebug **/ +:: *CollectAdmin = + { ca_error :: !*ParseErrorAdmin + , ca_fun_count :: !Int + , ca_rev_fun_defs :: ![FunDef] + , ca_predefs :: !PredefinedIdents + , ca_u_predefs :: !*PredefinedSymbols + , ca_hash_table :: !*HashTable + } + cIsAGlobalDef :== True cIsNotAGlobalDef :== False @@ -40,9 +49,7 @@ exprToRhs expr { ewl_nodes = [] , ewl_expr = expr , ewl_locals = LocalParsedDefs [] -// , ewl_locals = CollectedLocalDefs {loc_functions = {ir_from=0,ir_to=0}, loc_nodes=[] } } -// , rhs_locals = CollectedLocalDefs {loc_functions = {ir_from=0,ir_to=0}, loc_nodes=[] } , rhs_locals = LocalParsedDefs [] } @@ -96,45 +103,52 @@ where get_file_and_line_nr (LinePos filename linenr) = (filename, linenr, No) -:: *CollectAdmin = - { ca_error :: !ParseErrorAdmin - , ca_fun_count :: !Int - , ca_predefs :: !PredefinedIdents - , ca_hash_table :: !*HashTable - } - -class collectFunctions a :: a !CollectAdmin -> (a, ![FunDef], !CollectAdmin) +class collectFunctions a :: a !*CollectAdmin -> (a, !*CollectAdmin) + +addFunctionsRange :: [FunDef] *CollectAdmin -> (IndexRange, *CollectAdmin) +addFunctionsRange fun_defs ca + # (frm, ca) + = ca!ca_fun_count + ca + = foldSt add_function fun_defs ca + (to, ca) + = ca!ca_fun_count + = ({ir_from = frm, ir_to = to}, ca) + where + add_function :: FunDef !*CollectAdmin -> !*CollectAdmin + add_function fun_def ca=:{ca_fun_count, ca_rev_fun_defs} + = {ca & ca_fun_count = ca.ca_fun_count + 1 + , ca_rev_fun_defs = [fun_def : ca.ca_rev_fun_defs] + } instance collectFunctions ParsedExpr where collectFunctions (PE_List exprs) ca - # (exprs, fun_defs, ca) = collectFunctions exprs ca - = (PE_List exprs, fun_defs, ca) + # (exprs, ca) = collectFunctions exprs ca + = (PE_List exprs, ca) collectFunctions (PE_Bound bound_expr) ca - # (bound_expr, fun_defs, ca) = collectFunctions bound_expr ca - = (PE_Bound bound_expr, fun_defs, ca) + # (bound_expr, ca) = collectFunctions bound_expr ca + = (PE_Bound bound_expr, ca) collectFunctions (PE_Lambda lam_ident args res) ca - # fun_count = ca.ca_fun_count - next_fun_count = inc fun_count - ((args,res), fun_defs, ca) = collectFunctions (args,res) {ca & ca_fun_count = next_fun_count} - fun_def = transformLambda lam_ident args res - = (PE_Let cIsStrict (CollectedLocalDefs { loc_functions = { ir_from = fun_count, ir_to = next_fun_count }, loc_nodes = [] }) - (PE_Ident lam_ident), [fun_def : fun_defs], ca) + # ((args,res), ca) = collectFunctions (args,res) ca + # (range, ca) = addFunctionsRange [transformLambda lam_ident args res] ca + = (PE_Let cIsStrict (CollectedLocalDefs { loc_functions = range, loc_nodes = [] }) + (PE_Ident lam_ident), ca) collectFunctions (PE_Record rec_expr type_name fields) ca - # ((rec_expr,fields), fun_defs, ca) = collectFunctions (rec_expr,fields) ca - = (PE_Record rec_expr type_name fields, fun_defs, ca) + # ((rec_expr,fields), ca) = collectFunctions (rec_expr,fields) ca + = (PE_Record rec_expr type_name fields, ca) collectFunctions (PE_Tuple exprs) ca - # (exprs, fun_defs, ca) = collectFunctions exprs ca - = (PE_Tuple exprs, fun_defs, ca) + # (exprs, ca) = collectFunctions exprs ca + = (PE_Tuple exprs, ca) collectFunctions (PE_Selection is_unique expr selectors) ca - # ((expr, selectors), fun_defs, ca) = collectFunctions (expr, selectors) ca - = (PE_Selection is_unique expr selectors, fun_defs, ca) + # ((expr, selectors), ca) = collectFunctions (expr, selectors) ca + = (PE_Selection is_unique expr selectors, ca) collectFunctions (PE_Update expr1 updates expr2) ca - # ((expr1, (updates, expr2)), fun_defs, ca) = collectFunctions (expr1, (updates, expr2)) ca - = (PE_Update expr1 updates expr2, fun_defs, ca) + # ((expr1, (updates, expr2)), ca) = collectFunctions (expr1, (updates, expr2)) ca + = (PE_Update expr1 updates expr2, ca) collectFunctions (PE_Case case_ident pattern_expr case_alts) ca - # ((pattern_expr,case_alts), fun_defs, ca) = collectFunctions (pattern_expr,case_alts) ca - = (PE_Case case_ident pattern_expr case_alts, fun_defs, ca) + # ((pattern_expr,case_alts), ca) = collectFunctions (pattern_expr,case_alts) ca + = (PE_Case case_ident pattern_expr case_alts, ca) collectFunctions (PE_If if_ident c t e) ca # true_pattern = PE_Basic (BVB True) false_pattern = PE_WildCard // PE_Basic (BVB False) @@ -143,8 +157,8 @@ where , {calt_pattern = false_pattern, calt_rhs = exprToRhs e} ]) ca collectFunctions (PE_Let strict locals in_expr) ca - # ((node_defs,in_expr), fun_defs, ca) = collectFunctions (locals,in_expr) ca - = (PE_Let strict node_defs in_expr, fun_defs, ca) + # ((node_defs,in_expr), ca) = collectFunctions (locals,in_expr) ca + = (PE_Let strict node_defs in_expr, ca) collectFunctions (PE_Compr gen_kind expr qualifiers) ca # (compr, ca) = transformComprehension gen_kind expr qualifiers ca @@ -158,152 +172,128 @@ where collectFunctions (PE_ArrayDenot exprs) ca=:{ca_predefs} = collectFunctions (transformArrayDenot exprs ca_predefs) ca collectFunctions expr ca - = (expr, [], ca) + = (expr, ca) instance collectFunctions [a] | collectFunctions a where - collectFunctions [x:xs] ca - # (x, fun_defs_in_x, ca) = collectFunctions x ca - (xs, fun_defs_in_xs, ca) = collectFunctions xs ca - = ([x:xs], fun_defs_in_x ++ fun_defs_in_xs, ca) - collectFunctions [] ca - = ([], [], ca) + collectFunctions l ca + = mapSt collectFunctions l ca instance collectFunctions (a,b) | collectFunctions a & collectFunctions b where collectFunctions (x,y) ca - # (x, fun_defs_in_x, ca) = collectFunctions x ca - (y, fun_defs_in_y, ca) = collectFunctions y ca - = ((x,y), fun_defs_in_x ++ fun_defs_in_y, ca) + # (x, ca) = collectFunctions x ca + (y, ca) = collectFunctions y ca + = ((x,y), ca) instance collectFunctions Qualifier where collectFunctions qual=:{qual_generators, qual_filter} ca - # ((qual_generators, qual_filter), fun_defs, ca) = collectFunctions (qual_generators, qual_filter) ca - = ({ qual & qual_generators = qual_generators, qual_filter = qual_filter }, fun_defs, ca) + # ((qual_generators, qual_filter), ca) = collectFunctions (qual_generators, qual_filter) ca + = ({ qual & qual_generators = qual_generators, qual_filter = qual_filter }, ca) instance collectFunctions Generator where collectFunctions gen=:{gen_pattern,gen_expr} ca - # ((gen_pattern,gen_expr), fun_defs, ca) = collectFunctions (gen_pattern,gen_expr) ca - = ({gen & gen_pattern = gen_pattern, gen_expr = gen_expr}, fun_defs, ca) - + # ((gen_pattern,gen_expr), ca) = collectFunctions (gen_pattern,gen_expr) ca + = ({gen & gen_pattern = gen_pattern, gen_expr = gen_expr}, ca) instance collectFunctions (Optional a) | collectFunctions a where collectFunctions (Yes expr) ca - # (expr, fun_defs, ca) = collectFunctions expr ca - = (Yes expr, fun_defs, ca) + # (expr, ca) = collectFunctions expr ca + = (Yes expr, ca) collectFunctions No ca - = (No, [], ca) + = (No, ca) instance collectFunctions ParsedSelection where collectFunctions (PS_Array index_expr) ca - # (index_expr, fun_defs, ca) = collectFunctions index_expr ca - = (PS_Array index_expr, fun_defs, ca) + # (index_expr, ca) = collectFunctions index_expr ca + = (PS_Array index_expr, ca) collectFunctions expr ca - = (expr, [], ca) + = (expr, ca) instance collectFunctions CaseAlt where collectFunctions calt=:{calt_pattern,calt_rhs} ca -// MW why not # (calt_rhs, fun_defs, ca) = collectFunctions calt_rhs ca - # ((calt_pattern,calt_rhs), fun_defs, ca) = collectFunctions (calt_pattern,calt_rhs) ca - = ({calt & calt_pattern = calt_pattern, calt_rhs = calt_rhs}, fun_defs, ca) - - -instance collectFunctions Sequence -where - collectFunctions (SQ_FromThen from_expr then_expr) ca - # ((from_expr,then_expr), fun_defs, ca) = collectFunctions (from_expr,then_expr) ca - = (SQ_FromThen from_expr then_expr, fun_defs, ca) - collectFunctions (SQ_FromThenTo from_expr then_expr to_expr) ca - # ((from_expr,(then_expr,to_expr)), fun_defs, ca) = collectFunctions (from_expr,(then_expr,to_expr)) ca - = (SQ_FromThenTo from_expr then_expr to_expr, fun_defs, ca) - collectFunctions (SQ_FromTo from_expr to_expr) ca - # ((from_expr,to_expr), fun_defs, ca) = collectFunctions (from_expr,to_expr) ca - = (SQ_FromTo from_expr to_expr, fun_defs, ca) - collectFunctions (SQ_From from_expr) ca - # (from_expr, fun_defs, ca) = collectFunctions from_expr ca - = (SQ_From from_expr, fun_defs, ca) + # ((calt_pattern,calt_rhs), ca) = collectFunctions (calt_pattern,calt_rhs) ca + = ({calt & calt_pattern = calt_pattern, calt_rhs = calt_rhs}, ca) instance collectFunctions (Bind a b) | collectFunctions a & collectFunctions b where collectFunctions bind=:{bind_src,bind_dst} ca - # ((bind_src,bind_dst), fun_defs, ca) = collectFunctions (bind_src,bind_dst) ca - = ({ bind_src = bind_src, bind_dst = bind_dst }, fun_defs, ca) + # ((bind_src,bind_dst), ca) = collectFunctions (bind_src,bind_dst) ca + = ({bind & bind_src = bind_src, bind_dst = bind_dst }, ca) instance collectFunctions OptGuardedAlts where collectFunctions (GuardedAlts guarded_exprs (Yes def_expr)) ca - # ((guarded_exprs, def_expr), fun_defs, ca) = collectFunctions (guarded_exprs, def_expr) ca - = (GuardedAlts guarded_exprs (Yes def_expr), fun_defs, ca) + # ((guarded_exprs, def_expr), ca) = collectFunctions (guarded_exprs, def_expr) ca + = (GuardedAlts guarded_exprs (Yes def_expr), ca) collectFunctions (GuardedAlts guarded_exprs No) ca - # (guarded_exprs, fun_defs, ca) = collectFunctions guarded_exprs ca - = (GuardedAlts guarded_exprs No, fun_defs, ca) + # (guarded_exprs, ca) = collectFunctions guarded_exprs ca + = (GuardedAlts guarded_exprs No, ca) collectFunctions (UnGuardedExpr unguarded_expr) ca - # (unguarded_expr, fun_defs, ca) = collectFunctions unguarded_expr ca - = (UnGuardedExpr unguarded_expr, fun_defs, ca) + # (unguarded_expr, ca) = collectFunctions unguarded_expr ca + = (UnGuardedExpr unguarded_expr, ca) instance collectFunctions GuardedExpr where collectFunctions alt=:{alt_nodes,alt_guard,alt_expr} ca - # ((alt_nodes, (alt_guard, alt_expr)), fun_defs, ca) = + # ((alt_nodes, (alt_guard, alt_expr)), ca) = collectFunctions (alt_nodes, (alt_guard, alt_expr)) ca - = ({alt & alt_nodes = alt_nodes, alt_guard = alt_guard, alt_expr = alt_expr}, fun_defs, ca) + = ({alt & alt_nodes = alt_nodes, alt_guard = alt_guard, alt_expr = alt_expr}, ca) instance collectFunctions ExprWithLocalDefs where collectFunctions expr=:{ewl_nodes, ewl_expr,ewl_locals} ca - # ((ewl_nodes, (ewl_expr, ewl_locals)), fun_defs, ca) = collectFunctions (ewl_nodes, (ewl_expr, ewl_locals)) ca - = ({expr & ewl_nodes = ewl_nodes, ewl_expr = ewl_expr, ewl_locals = ewl_locals}, fun_defs, ca) + # ((ewl_nodes, (ewl_expr, ewl_locals)), ca) = collectFunctions (ewl_nodes, (ewl_expr, ewl_locals)) ca + = ({expr & ewl_nodes = ewl_nodes, ewl_expr = ewl_expr, ewl_locals = ewl_locals}, ca) instance collectFunctions NodeDefWithLocals where collectFunctions node_def=:{ndwl_def, ndwl_locals} ca - # (( ndwl_def, ndwl_locals), fun_defs, ca) = collectFunctions (ndwl_def, ndwl_locals) ca - = ({node_def & ndwl_def = ndwl_def, ndwl_locals = ndwl_locals}, fun_defs, ca) + # (( ndwl_def, ndwl_locals), ca) = collectFunctions (ndwl_def, ndwl_locals) ca + = ({node_def & ndwl_def = ndwl_def, ndwl_locals = ndwl_locals}, ca) instance collectFunctions Rhs where collectFunctions {rhs_alts, rhs_locals} ca - # ((rhs_alts, rhs_locals), fun_defs, ca) = collectFunctions (rhs_alts, rhs_locals) ca - = ({rhs_alts = rhs_alts, rhs_locals = rhs_locals}, fun_defs, ca) + # ((rhs_alts, rhs_locals), ca) = collectFunctions (rhs_alts, rhs_locals) ca + = ({rhs_alts = rhs_alts, rhs_locals = rhs_locals}, ca) instance collectFunctions LocalDefs where collectFunctions (LocalParsedDefs locals) ca - # (fun_defs, node_defs, ca) = reorganizeLocalDefinitions locals ca - ir_from = ca.ca_fun_count - ir_to = ca.ca_fun_count + length fun_defs - (node_defs, fun_defs_in_node_defs, ca) = collect_functions_in_node_defs node_defs {ca & ca_fun_count = ir_to} - (fun_defs, collected_fun_defs, ca) = reorganizeLocalDefinitionsOfFunctions fun_defs ca - = (CollectedLocalDefs { loc_functions = { ir_from = ir_from, ir_to = ir_to }, loc_nodes = node_defs }, - fun_defs ++ fun_defs_in_node_defs ++ collected_fun_defs, ca) + # (fun_defs, node_defs, ca) = reorganiseLocalDefinitions locals ca + (node_defs, ca) = collect_functions_in_node_defs node_defs ca + (fun_defs, ca) = collectFunctions fun_defs ca + (range, ca) = addFunctionsRange fun_defs ca + = (CollectedLocalDefs { loc_functions = range, loc_nodes = node_defs }, ca) where - collect_functions_in_node_defs :: [(Optional SymbolType,NodeDef ParsedExpr)] *CollectAdmin -> ([(Optional SymbolType,NodeDef ParsedExpr)],[FunDef],*CollectAdmin) + collect_functions_in_node_defs :: [(Optional SymbolType,NodeDef ParsedExpr)] *CollectAdmin -> ([(Optional SymbolType,NodeDef ParsedExpr)],*CollectAdmin) collect_functions_in_node_defs [ (node_def_type, bind) : node_defs ] ca - # (bind, fun_defs_in_bind, ca) = collectFunctions bind ca - (node_defs, fun_defs_in_node_defs, ca) = collect_functions_in_node_defs node_defs ca - = ([(node_def_type, bind):node_defs], fun_defs_in_bind ++ fun_defs_in_node_defs, ca) + # (bind, ca) = collectFunctions bind ca + (node_defs, ca) = collect_functions_in_node_defs node_defs ca + = ([(node_def_type, bind):node_defs], ca) collect_functions_in_node_defs [] ca - = ([], [], ca) + = ([], ca) // RWS ... +++ remove recollection collectFunctions locals ca - = (locals, [], ca) + = (locals, ca) // ... RWS instance collectFunctions (NodeDef a) | collectFunctions a where collectFunctions node_def=:{nd_dst,nd_alts,nd_locals} ca - # ((nd_dst,(nd_alts,nd_locals)), fun_defs, ca) = collectFunctions (nd_dst,(nd_alts,nd_locals)) ca - = ({ node_def & nd_dst = nd_dst, nd_alts = nd_alts, nd_locals = nd_locals }, fun_defs, ca) - + # ((nd_dst,(nd_alts,nd_locals)), ca) = collectFunctions (nd_dst,(nd_alts,nd_locals)) ca + = ({ node_def & nd_dst = nd_dst, nd_alts = nd_alts, nd_locals = nd_locals }, ca) + instance collectFunctions Ident where collectFunctions e ca - = (e, [], ca) + = (e, ca) NoCollectedLocalDefs :== CollectedLocalDefs { loc_functions = { ir_from = 0, ir_to = 0 }, loc_nodes = [] } @@ -601,8 +591,7 @@ makeComprehensions [{tq_generators, tq_filter, tq_end, tq_call, tq_lhs_args, tq_ get_predef_id :: Int *CollectAdmin -> (Ident, *CollectAdmin) get_predef_id predef_index ca=:{ca_predefs} - #! symb = ca_predefs.[predef_index] - = (symb, ca) + = ca!ca_predefs.[predef_index] transformSequence :: Sequence -> PredefinedIdents -> ParsedExpr transformSequence (SQ_FromThen frm then) @@ -629,18 +618,18 @@ transformArrayDenot exprs pi [{bind_dst=toParsedExpr i pi, bind_src=expr} \\ expr <- exprs & i <- [0..]] pi -scanModules :: [ParsedImport] [ScannedModule] Int *HashTable *File SearchPaths *PredefinedSymbols *Files -> (Bool, [ScannedModule],[FunDef],Int, *HashTable, *File, *PredefinedSymbols, *Files) -scanModules [] parsed_modules fun_count hash_table err_file searchPaths predefs files - = (True, parsed_modules, [], fun_count, hash_table, err_file, predefs, files) -scanModules [{import_module,import_symbols} : mods] parsed_modules fun_count hash_table err_file searchPaths predefs files +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 # (found, mod) = try_to_find import_module parsed_modules | found - = scanModules mods parsed_modules fun_count hash_table err_file searchPaths predefs files - # (succ, parsed_modules, local_fun_defs, fun_count, hash_table, err_file, predefs, files) - = parseAndScanDclModule import_module parsed_modules fun_count hash_table err_file searchPaths predefs files - (mods_succ, parsed_modules, local_fun_defs_in_imports, fun_count, hash_table, err_file, predefs, files) - = scanModules mods parsed_modules fun_count hash_table err_file searchPaths predefs files - = (succ && mods_succ, parsed_modules, local_fun_defs ++ local_fun_defs_in_imports, fun_count, hash_table, err_file, predefs, files) + = scanModules mods parsed_modules searchPaths files ca + # (succ, parsed_modules, files, ca) + = parseAndScanDclModule import_module 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) where try_to_find :: Ident [ScannedModule] -> (Bool, ScannedModule) try_to_find mod_id [] @@ -654,85 +643,95 @@ 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] !Int !*HashTable !*File !SearchPaths !*PredefinedSymbols !*Files - -> *(!Bool, ![ScannedModule], ![FunDef], !Int, !*HashTable, !*File, !*PredefinedSymbols, !*Files) -parseAndScanDclModule dcl_module parsed_modules fun_count hash_table err_file searchPaths predefs files - # (parse_ok, mod, hash_table, err_file, predefs, files) = wantModule cWantDclFile dcl_module hash_table err_file searchPaths predefs files +parseAndScanDclModule :: !Ident ![ScannedModule] !SearchPaths !*Files !*CollectAdmin + -> *(!Bool, ![ScannedModule], !*Files, !*CollectAdmin) +parseAndScanDclModule dcl_module 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 + # 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 fun_count hash_table err_file searchPaths predefs files - = (False, [ MakeEmptyModule mod.mod_name : parsed_modules ], [], fun_count, hash_table, err_file, predefs, files) + = scan_dcl_module mod parsed_modules searchPaths files ca + = (False, [MakeEmptyModule mod.mod_name : parsed_modules], files, ca) where - scan_dcl_module :: ParsedModule [ScannedModule] Int *HashTable *File SearchPaths *PredefinedSymbols *Files -> (Bool, [ScannedModule], [FunDef], Int, *HashTable, *File, *PredefinedSymbols, *Files) - scan_dcl_module mod=:{mod_defs = pdefs} parsed_modules fun_count hash_table err_file searchPaths predefs files - # (predefIdents, predefs) = SelectPredefinedIdents predefs - # state = {ca_error = { pea_file = err_file, pea_ok = True }, ca_fun_count = 0, ca_predefs = predefIdents, ca_hash_table = hash_table} - (_, defs, imports, imported_objects, state) = reorganizeDefinitions False pdefs 0 0 0 state - macro_count = length defs.def_macros + fun_count - (macro_defs, local_fun_defs, {ca_fun_count=new_fun_count, ca_error={pea_file,pea_ok}, ca_predefs, ca_hash_table=hash_table}) - = reorganizeLocalDefinitionsOfFunctions defs.def_macros {state & ca_fun_count = macro_count} - mod = { mod & mod_imports = imports, mod_imported_objects = imported_objects, mod_defs = { defs & def_macros = { ir_from = fun_count, ir_to = macro_count } }} - (import_ok, parsed_modules, imported_local_fun_defs, fun_count, hash_table, err_file, predefs, files) - = scanModules imports [mod : parsed_modules] new_fun_count hash_table pea_file searchPaths predefs files - = (pea_ok && import_ok, parsed_modules, macro_defs ++ local_fun_defs ++ imported_local_fun_defs, fun_count, hash_table, err_file, predefs, files) + scan_dcl_module :: ParsedModule [ScannedModule] !SearchPaths *Files *CollectAdmin -> (Bool, [ScannedModule], *Files, *CollectAdmin) + scan_dcl_module mod=:{mod_defs = pdefs} parsed_modules searchPaths files ca + # (_, defs, imports, imported_objects, ca) + = reorganiseDefinitions False pdefs 0 0 0 ca + (macro_defs, ca) + = collectFunctions defs.def_macros ca + (range, ca) + = addFunctionsRange macro_defs ca + (pea_ok,ca) + = ca!ca_error.pea_ok + mod + = { mod & mod_imports = imports, mod_imported_objects = imported_objects, mod_defs = { defs & def_macros = range }} + (import_ok, parsed_modules, files, ca) + = scanModules imports [mod : parsed_modules] searchPaths files ca + = (pea_ok && import_ok, parsed_modules, files, ca) scanModule :: !ParsedModule !*HashTable !*File !SearchPaths !*PredefinedSymbols !*Files - -> (!Bool, !ScannedModule, !Int, ![FunDef], !ScannedModule, !ScannedModule, ![ScannedModule], !*HashTable, !*File, !*PredefinedSymbols, !*Files) + -> (!Bool, !ScannedModule, !IndexRange, ![FunDef], !ScannedModule, !ScannedModule, ![ScannedModule], !*HashTable, !*File, !*PredefinedSymbols, !*Files) scanModule mod=:{mod_name,mod_type,mod_defs = pdefs} hash_table err_file searchPaths predefs files # (predefIdents, predefs) = SelectPredefinedIdents predefs - # state = {ca_fun_count = 0, ca_error = { pea_file = err_file, pea_ok = True }, ca_predefs = predefIdents, ca_hash_table = hash_table} - (fun_defs, defs, imports, imported_objects, ca) = reorganizeDefinitions True pdefs 0 0 0 state - fun_count = length fun_defs - macro_count = length defs.def_macros - (fun_defs, local_defs, ca) = reorganizeLocalDefinitionsOfFunctions (fun_defs ++ defs.def_macros) {ca & ca_fun_count = fun_count + macro_count} - (def_instances, local_defs_in_insts, {ca_fun_count=tot_fun_count, ca_error = {pea_file,pea_ok}, ca_predefs, ca_hash_table=hash_table}) - = reorganizeLocalDefinitionsOfInstances defs.def_instances ca - (import_dcl_ok, parsed_modules, local_defs_in_dcl, tot_fun_count, hash_table, err_file, ca_predefs, files) - = scan_dcl_module mod_name mod_type tot_fun_count hash_table pea_file predefs files - (import_dcls_ok, parsed_modules, local_defs_in_imports, tot_fun_count, hash_table, err_file, ca_predefs, files) - = scanModules imports parsed_modules tot_fun_count hash_table err_file searchPaths ca_predefs files + # ca = { ca_error = {pea_file = err_file, pea_ok = True} + , ca_fun_count = 0 + , ca_rev_fun_defs = [] + , ca_predefs = predefIdents + , ca_u_predefs = predefs + , ca_hash_table = hash_table + } + (fun_defs, defs, imports, imported_objects, ca) = reorganiseDefinitions True pdefs 0 0 0 ca + fun_count = length fun_defs + (fun_defs, ca) = collectFunctions fun_defs ca + (fun_range, ca) = addFunctionsRange fun_defs ca + (macro_defs, ca) = collectFunctions defs.def_macros ca + (macro_range, ca) = addFunctionsRange macro_defs ca + (def_instances, ca) + = collectFunctions defs.def_instances ca + (pea_ok, ca) = ca!ca_error.pea_ok + (import_dcl_ok, parsed_modules, files, ca) + = scan_dcl_module mod_name mod_type searchPaths files ca + (import_dcls_ok, parsed_modules, files, ca) + = scanModules imports parsed_modules searchPaths files ca + { ca_error = {pea_file = err_file} + , ca_predefs = predefs + , ca_rev_fun_defs + , ca_u_predefs + , ca_hash_table = hash_table + } + = ca mod = { mod & mod_imports = imports, mod_imported_objects = imported_objects, mod_defs = { defs & def_instances = def_instances, - def_macros = { ir_from = fun_count, ir_to = fun_count + macro_count } }} + def_macros = macro_range }} [dcl_mod : modules] = reverse parsed_modules - all_local_defs = fun_defs ++ local_defs ++ local_defs_in_insts ++ local_defs_in_dcl ++ local_defs_in_imports - (pre_def_mod, ca_predefs) = buildPredefinedModule ca_predefs - = (pea_ok && import_dcl_ok && import_dcls_ok, mod, fun_count, all_local_defs, dcl_mod, pre_def_mod, modules, hash_table, err_file, ca_predefs, files) + (pre_def_mod, ca_u_predefs) = buildPredefinedModule ca_u_predefs + = (pea_ok && import_dcl_ok && import_dcls_ok, mod, fun_range, reverse ca_rev_fun_defs, dcl_mod, pre_def_mod, modules, hash_table, err_file, ca_u_predefs, files) where - scan_dcl_module :: Ident ModuleKind Int *HashTable *File *PredefinedSymbols *Files -> (Bool, [ScannedModule], [FunDef], Int, *HashTable, *File, *PredefinedSymbols, *Files) - scan_dcl_module mod_name MK_Main fun_count hash_table err_file predefs files - = (True, [MakeEmptyModule mod_name ], [], fun_count, hash_table, err_file, predefs, files) - scan_dcl_module mod_name MK_None fun_count hash_table err_file predefs files - = (True, [MakeEmptyModule mod_name ], [], fun_count, hash_table, err_file, predefs , files) - scan_dcl_module mod_name kind fun_count hash_table err_file predefs files - = parseAndScanDclModule mod_name [] fun_count hash_table err_file searchPaths predefs files - -reorganizeLocalDefinitionsOfInstances :: [ParsedInstance FunDef] *CollectAdmin -> ([ParsedInstance FunDef], [FunDef], *CollectAdmin) -reorganizeLocalDefinitionsOfInstances [] ca - = ([], [], ca) -reorganizeLocalDefinitionsOfInstances [inst=:{pi_members} : insts] ca - # (pi_members, local_defs, ca) = reorganizeLocalDefinitionsOfFunctions pi_members ca - (insts, local_defs_in_insts, ca) = reorganizeLocalDefinitionsOfInstances insts ca - = ([{inst & pi_members = pi_members } : insts], local_defs ++ local_defs_in_insts, ca) - -reorganizeLocalDefinitionsOfFunction :: FunDef *CollectAdmin -> (FunDef, [FunDef], *CollectAdmin) -reorganizeLocalDefinitionsOfFunction fun_def=:{fun_body = ParsedBody bodies} ca - # (bodies, rhs_fun_defs, ca) = collect_local_definitions_in_bodies bodies ca - = ({fun_def & fun_body = ParsedBody bodies}, rhs_fun_defs, ca) -where - collect_local_definitions_in_bodies :: [ParsedBody] *CollectAdmin -> ([ParsedBody], [FunDef], CollectAdmin) - collect_local_definitions_in_bodies [pb=:{pb_rhs} : bodies] ca - # (pb_rhs, rhs_fun_defs, ca) = collectFunctions pb_rhs ca - (bodies, body_fun_defs, ca) = collect_local_definitions_in_bodies bodies ca - = ([ { pb & pb_rhs = pb_rhs } : bodies], rhs_fun_defs ++ body_fun_defs, ca) - collect_local_definitions_in_bodies [] ca - = ([], [], ca) - -reorganizeLocalDefinitionsOfFunctions :: [FunDef] *CollectAdmin -> ([FunDef], [FunDef], *CollectAdmin) -reorganizeLocalDefinitionsOfFunctions [] ca - = ([], [], ca) -reorganizeLocalDefinitionsOfFunctions [fun_def : fun_defs] ca - # (fun_def, rhs_fun_defs, ca) = reorganizeLocalDefinitionsOfFunction fun_def ca - (fun_defs, rhss_fun_defs, ca) = reorganizeLocalDefinitionsOfFunctions fun_defs ca - = ([fun_def : fun_defs], rhs_fun_defs ++ rhss_fun_defs, ca) + scan_dcl_module :: Ident ModuleKind SearchPaths *Files *CollectAdmin -> (Bool, [ScannedModule], *Files, *CollectAdmin) + scan_dcl_module mod_name MK_Main searchPaths files ca + = (True, [MakeEmptyModule mod_name], files, ca) + 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 + +instance collectFunctions (ParsedInstance a) | collectFunctions a where + collectFunctions inst=:{pi_members} ca + # (pi_members, ca) = collectFunctions pi_members ca + = ({inst & pi_members = pi_members }, ca) + +instance collectFunctions FunDef where + collectFunctions fun_def=:{fun_body = ParsedBody bodies} ca + # (bodies, ca) = collectFunctions bodies ca + = ({fun_def & fun_body = ParsedBody bodies}, ca) + +instance collectFunctions ParsedBody where + collectFunctions pb=:{pb_rhs} ca + # (pb_rhs, ca) = collectFunctions pb_rhs ca + = ({ pb & pb_rhs = pb_rhs }, ca) 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, @@ -768,37 +767,37 @@ collectFunctionBodies fun_name fun_arity fun_prio fun_kind all_defs=:[PD_Functio collectFunctionBodies fun_name fun_arity fun_prio fun_kind defs ca = ([], fun_kind, defs, ca) -reorganizeDefinitions :: Bool [ParsedDefinition] Index Index Index *CollectAdmin -> ([FunDef],CollectedDefinitions (ParsedInstance FunDef) [FunDef], [ParsedImport], [ImportedObject], *CollectAdmin) -reorganizeDefinitions icl_module [PD_Function pos name is_infix args rhs fun_kind : defs] cons_count sel_count mem_count ca +reorganiseDefinitions :: Bool [ParsedDefinition] Index Index Index *CollectAdmin -> ([FunDef],CollectedDefinitions (ParsedInstance FunDef) [FunDef], [ParsedImport], [ImportedObject], *CollectAdmin) +reorganiseDefinitions icl_module [PD_Function pos name is_infix args rhs fun_kind : defs] cons_count sel_count mem_count ca # prio = if is_infix (Prio NoAssoc 9) NoPrio fun_arity = length args (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca - (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca + (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies] fun_kind prio No pos | fun_kind == FK_Macro = (fun_defs, { c_defs & def_macros = [ fun : c_defs.def_macros ]}, imports, imported_objects, ca) = ([ fun : fun_defs ], c_defs, imports, imported_objects, ca) -reorganizeDefinitions icl_module [PD_TypeSpec fun_pos fun_name prio No specials : defs] cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_TypeSpec fun_pos fun_name prio No specials : defs] cons_count sel_count mem_count ca = case defs of [PD_Function pos name is_infix args rhs fun_kind : defs] | fun_name <> name - -> reorganizeDefinitions icl_module defs cons_count sel_count mem_count (postParseError fun_pos ("function alternative for "+++fun_name.id_name+++" expected") ca) + -> reorganiseDefinitions icl_module defs cons_count sel_count mem_count (postParseError fun_pos ("function alternative for "+++fun_name.id_name+++" expected") ca) | not (sameFixity prio is_infix) - -> reorganizeDefinitions icl_module defs cons_count sel_count mem_count (postParseError fun_pos "infix of type specification and alternative should match" ca) + -> reorganiseDefinitions icl_module defs cons_count sel_count mem_count (postParseError fun_pos "infix of type specification and alternative should match" ca) // | belongsToTypeSpec fun_name prio name is_infix # fun_arity = length args (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca - (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca + (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies ] fun_kind prio No pos | fun_kind == FK_Macro -> (fun_defs, { c_defs & def_macros = [ fun : c_defs.def_macros]}, imports, imported_objects, ca) -> ([ fun : fun_defs ], c_defs, imports, imported_objects, ca) - // -> reorganizeDefinitions icl_module defs cons_count sel_count mem_count (postParseError fun_pos "function body expected (1)" ca) + // -> reorganiseDefinitions icl_module defs cons_count sel_count mem_count (postParseError fun_pos "function body expected (1)" ca) _ - -> reorganizeDefinitions icl_module defs cons_count sel_count mem_count (postParseError fun_pos "function alternative expected (2)" ca) -reorganizeDefinitions icl_module [PD_TypeSpec pos name prio (Yes fun_type=:{st_arity}) specials : defs] cons_count sel_count mem_count ca + -> reorganiseDefinitions icl_module defs cons_count sel_count mem_count (postParseError fun_pos "function alternative expected (2)" ca) +reorganiseDefinitions icl_module [PD_TypeSpec pos name prio (Yes fun_type=:{st_arity}) specials : defs] cons_count sel_count mem_count ca # (bodies, fun_kind, defs, ca) = collectFunctionBodies name st_arity prio FK_Unknown defs ca - (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca + (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca | isEmpty bodies # fun_type = MakeNewFunctionType name st_arity prio fun_type pos specials nilPtr c_defs = { c_defs & def_funtypes = [ fun_type : c_defs.def_funtypes ]} @@ -809,9 +808,9 @@ reorganizeDefinitions icl_module [PD_TypeSpec pos name prio (Yes fun_type=:{st_a | icl_module = ([fun : fun_defs], c_defs, imports, imported_objects, ca) = ([fun : fun_defs], c_defs, imports, imported_objects, postParseError pos "function body not allowed in definition module" ca) -reorganizeDefinitions icl_module [PD_Type type_def=:{td_rhs = ConsList cons_defs} : defs] cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = ConsList cons_defs} : defs] cons_count sel_count mem_count ca # (cons_symbs, cons_count) = determine_symbols_of_conses cons_defs cons_count - (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca + (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca type_def = { type_def & td_rhs = AlgType cons_symbs } c_defs = { c_defs & def_types = [type_def : c_defs.def_types], def_constructors = mapAppend ParsedConstructorToConsDef cons_defs c_defs.def_constructors } = (fun_defs, c_defs, imports, imported_objects, ca) @@ -823,9 +822,9 @@ where = ([cons : conses], next_cons_index) determine_symbols_of_conses [] next_cons_index = ([], next_cons_index) -reorganizeDefinitions icl_module [PD_Type type_def=:{td_name, td_rhs = SelectorList rec_cons_id exivars sel_defs, td_pos } : defs] cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_Type type_def=:{td_name, td_rhs = SelectorList rec_cons_id exivars sel_defs, td_pos } : defs] cons_count sel_count mem_count ca # (sel_syms, new_count) = determine_symbols_of_selectors sel_defs sel_count - (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs (inc cons_count) new_count mem_count ca + (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs (inc cons_count) new_count mem_count ca cons_arity = new_count - sel_count cons_def = { pc_cons_name = rec_cons_id, pc_cons_prio = NoPrio, pc_cons_arity = cons_arity, pc_cons_pos = td_pos, pc_arg_types = [ ps_field_type \\ {ps_field_type} <- sel_defs ], pc_exi_vars = exivars } @@ -843,28 +842,27 @@ where determine_symbols_of_selectors [] next_selector_index = ([], next_selector_index) -reorganizeDefinitions icl_module [PD_Type type_def=:{td_rhs = TypeSpec type} : defs] cons_count sel_count mem_count ca - # (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = TypeSpec type} : defs] cons_count sel_count mem_count ca + # (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca type_def = { type_def & td_rhs = SynType type } c_defs = { c_defs & def_types = [type_def : c_defs.def_types] } = (fun_defs, c_defs, imports, imported_objects, ca) -reorganizeDefinitions icl_module [PD_Type type_def=:{td_rhs = EmptyRhs properties} : defs] cons_count sel_count mem_count ca - # (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = EmptyRhs properties} : defs] cons_count sel_count mem_count ca + # (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca type_def = { type_def & td_rhs = AbstractType properties } c_defs = { c_defs & def_types = [type_def : c_defs.def_types] } = (fun_defs, c_defs, imports, imported_objects, ca) -reorganizeDefinitions icl_module [PD_Class class_def=:{class_name,class_arity,class_args} members : defs] cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_Class class_def=:{class_name,class_arity,class_args} members : defs] cons_count sel_count mem_count ca # type_context = { tc_class = {glob_module = NoIndex, glob_object = {ds_ident = class_name, ds_arity = class_arity, ds_index = NoIndex }}, tc_types = [ TV tv \\ tv <- class_args ], tc_var = nilPtr } (mem_defs, mem_macros, ca) = check_symbols_of_class_members members type_context ca - (mem_symbs, mem_defs, class_size) = reorganize_member_defs mem_defs mem_count - (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count (mem_count + class_size) ca + (mem_symbs, mem_defs, class_size) = reorganise_member_defs mem_defs mem_count + (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count (mem_count + class_size) ca class_def = { class_def & class_members = { member \\ member <- mem_symbs }} c_defs = { c_defs & def_classes = [class_def : c_defs.def_classes], def_macros = mem_macros ++ c_defs.def_macros, def_members = mem_defs ++ c_defs.def_members } = (fun_defs, c_defs, imports, imported_objects, ca) where - check_symbols_of_class_members :: ![ParsedDefinition] !TypeContext !*CollectAdmin -> (![MemberDef], ![FunDef], !*CollectAdmin) check_symbols_of_class_members [PD_TypeSpec pos name prio opt_type=:(Yes type=:{st_context,st_arity}) specials : defs] type_context ca # (bodies, fun_kind, defs, ca) = collectFunctionBodies name st_arity prio FK_Unknown defs ca @@ -900,8 +898,8 @@ where check_symbols_of_class_members [] type_context ca = ([], [], ca) - reorganize_member_defs :: [MemberDef] Index -> ([DefinedSymbol], [MemberDef], Index) - reorganize_member_defs mem_defs first_mem_index + reorganise_member_defs :: [MemberDef] Index -> ([DefinedSymbol], [MemberDef], Index) + reorganise_member_defs mem_defs first_mem_index # mem_defs = sort mem_defs = determine_indexes_of_class_members mem_defs first_mem_index 0 @@ -913,9 +911,8 @@ where determine_indexes_of_class_members [] first_mem_index last_mem_offset = ([], [], last_mem_offset) - -reorganizeDefinitions icl_module [PD_Instance class_instance=:{pi_members,pi_pos} : defs] cons_count sel_count mem_count ca - # (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_Instance class_instance=:{pi_members,pi_pos} : defs] cons_count sel_count mem_count ca + # (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca (mem_defs, ca) = collect_member_instances pi_members ca | icl_module || isEmpty mem_defs = (fun_defs, { c_defs & def_instances = [{class_instance & pi_members = mem_defs} : c_defs.def_instances] }, imports, imported_objects, ca) @@ -943,60 +940,50 @@ where -> collect_member_instances defs (postParseError fun_pos "function body expected" ca) collect_member_instances [] ca = ([], ca) -reorganizeDefinitions icl_module [PD_Instances class_instances : defs] cons_count sel_count mem_count ca - = reorganizeDefinitions icl_module ([PD_Instance class_instance \\ class_instance <- class_instances] ++ defs) cons_count sel_count mem_count ca -reorganizeDefinitions icl_module [PD_Import new_imports : defs] cons_count sel_count mem_count ca - # (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_Instances class_instances : defs] cons_count sel_count mem_count ca + = reorganiseDefinitions icl_module ([PD_Instance class_instance \\ class_instance <- class_instances] ++ defs) cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_Import new_imports : defs] cons_count sel_count mem_count ca + # (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca = (fun_defs, c_defs, new_imports ++ imports, imported_objects, ca) -reorganizeDefinitions icl_module [PD_ImportedObjects new_imported_objects : defs] cons_count sel_count mem_count ca - # (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca +reorganiseDefinitions icl_module [PD_ImportedObjects new_imported_objects : defs] cons_count sel_count mem_count ca + # (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca = (fun_defs, c_defs, imports, new_imported_objects ++ imported_objects, ca) -reorganizeDefinitions icl_module [def:defs] _ _ _ ca - = abort ("reorganizeDefinitions does not match" ---> def) +reorganiseDefinitions icl_module [def:defs] _ _ _ ca + = abort ("reorganiseDefinitions does not match" ---> def) -reorganizeDefinitions icl_module [] _ _ _ ca +reorganiseDefinitions icl_module [] _ _ _ ca = ([], { def_types = [], def_constructors = [], def_selectors = [], def_macros = [], def_classes = [], def_members = [], def_instances = [], def_funtypes = [] }, [], [], ca) -checkRhsOfNodeDef :: Position Rhs *CollectAdmin -> (ParsedExpr, *CollectAdmin) -checkRhsOfNodeDef pos { rhs_alts = UnGuardedExpr {ewl_expr,ewl_nodes = [],ewl_locals = LocalParsedDefs []}, rhs_locals = LocalParsedDefs []} ca - = (ewl_expr, ca) -checkRhsOfNodeDef pos rhs ca - = (PE_Empty, postParseError pos "illegal node definition" ca) - - -reorganizeLocalDefinitions :: [ParsedDefinition] *CollectAdmin -> ([FunDef],[(Optional SymbolType,NodeDef ParsedExpr)],*CollectAdmin) -reorganizeLocalDefinitions [PD_NodeDef pos pattern {rhs_alts,rhs_locals} : defs] ca - # (fun_defs, node_defs, ca) = reorganizeLocalDefinitions defs ca +reorganiseLocalDefinitions :: [ParsedDefinition] *CollectAdmin -> ([FunDef],[(Optional SymbolType,NodeDef ParsedExpr)],*CollectAdmin) +reorganiseLocalDefinitions [PD_NodeDef pos pattern {rhs_alts,rhs_locals} : defs] ca + # (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca = (fun_defs, [(No, { nd_dst = pattern, nd_alts = rhs_alts, nd_locals = rhs_locals }) : node_defs], ca) -// = (fun_defs, [(No, { bind_dst = pattern, bind_src = rhs_expr }) : node_defs], ca) -reorganizeLocalDefinitions [PD_Function pos name is_infix args rhs fun_kind : defs] ca +reorganiseLocalDefinitions [PD_Function pos name is_infix args rhs fun_kind : defs] ca # prio = if is_infix (Prio NoAssoc 9) NoPrio fun_arity = length args (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca - (fun_defs, node_defs, ca) = reorganizeLocalDefinitions defs ca + (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies ] fun_kind prio No pos = ([ fun : fun_defs ], node_defs, ca) -reorganizeLocalDefinitions [PD_TypeSpec pos1 name1 prio type specials : defs] ca +reorganiseLocalDefinitions [PD_TypeSpec pos1 name1 prio type specials : defs] ca = case defs of [PD_Function pos name is_infix args rhs fun_kind : _] | belongsToTypeSpec name1 prio name is_infix # fun_arity = determineArity args type # (bodies, fun_kind, defs, ca) = collectFunctionBodies name1 fun_arity prio fun_kind defs ca - (fun_defs, node_defs, ca) = reorganizeLocalDefinitions defs ca + (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca fun = MakeNewFunction name fun_arity bodies fun_kind prio type pos -> ([fun : fun_defs], node_defs, ca) - -> reorganizeLocalDefinitions defs (postParseError pos "function body expected" ca) + -> reorganiseLocalDefinitions defs (postParseError pos "function body expected" ca) [PD_NodeDef pos pattern=:(PE_Ident id) {rhs_alts,rhs_locals} : defs] | belongsToTypeSpec name1 prio id False - # (fun_defs, node_defs, ca) = reorganizeLocalDefinitions defs ca -// (rhs_expr, ca) = checkRhsOfNodeDef pos rhs ca + # (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca -> (fun_defs, [(type, { nd_dst = pattern, nd_alts = rhs_alts, nd_locals = rhs_locals }) : node_defs], ca) -// -> (fun_defs, [(type, { bind_dst = pattern, bind_src = rhs_expr }) : node_defs], ca) - -> reorganizeLocalDefinitions defs (postParseError pos "function body expected" ca) + -> reorganiseLocalDefinitions defs (postParseError pos "function body expected" ca) _ - -> reorganizeLocalDefinitions defs (postParseError pos1 "function body expected" ca) -reorganizeLocalDefinitions [] ca + -> reorganiseLocalDefinitions defs (postParseError pos1 "function body expected" ca) +reorganiseLocalDefinitions [] ca = ([], [], ca) |