diff options
Diffstat (limited to 'frontend/trans.icl')
| -rw-r--r-- | frontend/trans.icl | 233 |
1 files changed, 0 insertions, 233 deletions
diff --git a/frontend/trans.icl b/frontend/trans.icl index f1837b5..3985063 100644 --- a/frontend/trans.icl +++ b/frontend/trans.icl @@ -4244,214 +4244,6 @@ where _ -> ([ v : global_vars ], var_heap) -/* -isYes (Yes _) = True -isYes _ = False -*/ - -//@ producerRequirements - -:: *PRState = - { prs_group :: ![Int] - , prs_cons_args :: !*{!ConsClasses} - , prs_main_dcl_module_n :: !Int - , prs_fun_heap :: !*FunctionHeap - , prs_fun_defs :: !*{#FunDef} - , prs_group_index :: !Int - } - -class producerRequirements a - :: !a !*PRState -> *(!Bool,!*PRState) - -instance producerRequirements [a] | producerRequirements a where - producerRequirements [] prs - = (True,prs) - producerRequirements [x:xs] prs - # (safe,prs) = producerRequirements x prs - | safe = producerRequirements xs prs - = (safe,prs) - -instance producerRequirements Expression where - producerRequirements (Var var) prs - = (True,prs) - producerRequirements (App {app_symb={symb_kind=(SK_Constructor _)},app_args}) prs - = producerRequirements app_args prs - producerRequirements app=:(App {app_symb,app_args}) prs -/* - # (rec,prs) = is_recursive_app app prs - | not rec - = producerRequirements app_args prs -*/ - // look up consumer class for app_symb args - #! (maybe_ca,prs) = retrieve_consumer_args app_symb prs - // need to check for recursive call in safe arg... - = case maybe_ca of - No // assuming that for functions that have no consumer info no unfolding will occur - // note that this means that generated functions must be visible this way... -// # prs = prs ---> ("No cons info for",app_symb) - -> (True,prs) - Yes ca // for each arg: - // if safe && top of arg is App of group member... - // else recurse into arg -// # prs = prs ---> ("Yes cons info for",app_symb,ca.cc_args,ca.cc_linear_bits) - -> check_app_arguments ca.cc_args ca.cc_linear_bits app_args prs - where - check_app_arguments [cc_arg:cc_args] [cc_linear_bit:cc_bits] [app_arg:app_args] prs - | cc_arg == CActive && cc_linear_bit - # (rec,prs) = is_recursive_app app_arg prs - | rec = (False,prs) - # (safe,prs)= producerRequirements app_arg prs - | safe = check_app_arguments cc_args cc_bits app_args prs - = (safe,prs) - # (safe,prs) = producerRequirements app_arg prs - | safe = check_app_arguments cc_args cc_bits app_args prs - = (safe,prs) - check_app_arguments _ _ _ prs - = (True,prs) - - is_recursive_app (App {app_symb}) prs - // check if app_symb member of prs_group - # {symb_kind} = app_symb - #! main_dcl_module_n = prs.prs_main_dcl_module_n - # { glob_module, glob_object } - = case symb_kind of - SK_Function global_index -> global_index - SK_LocalMacroFunction index -> { glob_module = main_dcl_module_n, glob_object = index } - SK_GeneratedFunction info_ptr index -> { glob_module = main_dcl_module_n, glob_object = index } - _ -> {glob_module = -1, glob_object = -1} - | glob_module <> main_dcl_module_n - = (False,prs) - #! (fun_def,fun_defs,fun_heap) = get_fun_def symb_kind prs.prs_main_dcl_module_n prs.prs_fun_defs prs.prs_fun_heap - prs = {prs & prs_fun_defs = fun_defs, prs_fun_heap = fun_heap} - rec = fun_def.fun_info.fi_group_index == prs.prs_group_index - = (rec,prs) - is_recursive_app _ prs - = (False,prs) - - producerRequirements (fun_expr @ exprs) prs - // recurse - # (safe,prs) = producerRequirements fun_expr prs - | safe = producerRequirements exprs prs - = (safe,prs) - producerRequirements (Let {let_strict_binds,let_lazy_binds,let_expr}) prs - // watch out for function shadowing by 'let' binds - // recurse into binding exprs - // continue with 'in' body - # (safe,prs) = producerRequirements let_lazy_binds prs - | not safe = (safe,prs) - # (safe,prs) = producerRequirements let_strict_binds prs - | not safe = (safe,prs) - # (safe,prs) = producerRequirements let_expr prs - | not safe = (safe,prs) - = (safe,prs) - producerRequirements (Case {case_expr,case_guards,case_default,case_ident}) prs - // watch out for function shadowing by guards or case ident - // check case_expr - # (safe,prs) = producerRequirements case_expr prs - | not safe = (safe,prs) - // check case_guards - # (safe,prs) = producerRequirements case_guards prs - | not safe = (safe,prs) - // check case_default - # (safe,prs) = producerRequirements case_default prs - | not safe = (safe,prs) - = (True,prs) - producerRequirements (Selection _ expr sels) prs - # (safe,prs) = producerRequirements expr prs - | safe = producerRequirements sels prs - = (safe,prs) - producerRequirements (Update expr1 sels expr2) prs - # (safe,prs) = producerRequirements expr1 prs - | not safe = (safe,prs) - # (safe,prs) = producerRequirements expr2 prs - | not safe = (safe,prs) - # (safe,prs) = producerRequirements sels prs - | not safe = (safe,prs) - = (True,prs) - producerRequirements (RecordUpdate _ expr exprs) prs - // ... - # (safe,prs) = producerRequirements expr prs - | safe = producerFieldRequirements exprs prs - = (safe,prs) - where - producerFieldRequirements [] prs - = (True,prs) - producerFieldRequirements [{bind_src}:fields] prs - # (safe,prs) = producerRequirements bind_src prs - | safe = producerFieldRequirements fields prs - = (safe,prs) - producerRequirements (TupleSelect _ _ expr) prs - = producerRequirements expr prs - producerRequirements (BasicExpr _) prs - = (True,prs) - producerRequirements (AnyCodeExpr _ _ _) prs - = (False,prs) - producerRequirements (ABCCodeExpr _ _) prs - = (False,prs) - producerRequirements (MatchExpr _ expr) prs - = producerRequirements expr prs - producerRequirements (DynamicExpr _) prs - = (False,prs) - producerRequirements (TypeCodeExpression _) prs - = (False,prs) - producerRequirements (EE) prs - = (False,prs) - producerRequirements (NoBind var) prs - = (True,prs) - producerRequirements (FailExpr _) prs - = (True,prs) - producerRequirements expr prs - = abort ("producerRequirements " ---> expr) - -instance producerRequirements (Optional a) | producerRequirements a where - producerRequirements (Yes x) prs - = producerRequirements x prs - producerRequirements No prs - = (True,prs) - -instance producerRequirements CasePatterns where - producerRequirements (AlgebraicPatterns index patterns) prs - // name shadowing... - # (safe,prs) = producerRequirements patterns prs - = (safe,prs) - producerRequirements (BasicPatterns type patterns) prs - // name shadowing... - # (safe,prs) = producerRequirements patterns prs - = (safe,prs) - producerRequirements (OverloadedListPatterns _ _ patterns) prs - // name shadowing... - # (safe,prs) = producerRequirements patterns prs - = (safe,prs) - producerRequirements (DynamicPatterns patterns) prs - //...disallow for now... - = (False,prs) - producerRequirements NoPattern prs - = (True,prs) - -instance producerRequirements AlgebraicPattern where - producerRequirements {ap_expr} prs - // name shadowing... - = producerRequirements ap_expr prs - -instance producerRequirements BasicPattern where - producerRequirements {bp_expr} prs - // name shadowing... - = producerRequirements bp_expr prs - -instance producerRequirements LetBind where - producerRequirements {lb_src} prs - = producerRequirements lb_src prs - -instance producerRequirements Selection where - producerRequirements (RecordSelection _ _) prs - = (True,prs) - producerRequirements (ArraySelection _ _ expr) prs - = producerRequirements expr prs - producerRequirements (DictionarySelection _ sels _ expr) prs - # (safe,prs) = producerRequirements expr prs - | safe = producerRequirements sels prs - = (safe,prs) - //@ fun_def & cons_arg getters... get_fun_def :: !SymbKind !Int !u:{#FunDef} !*FunctionHeap -> (!FunDef, !u:{#FunDef}, !*FunctionHeap) @@ -4490,31 +4282,6 @@ get_fun_def_and_cons_args (SK_GeneratedFunction fun_info_ptr fun_index) cons_arg # (FI_Function {gf_fun_def, gf_cons_args}, fun_heap) = readPtr fun_info_ptr fun_heap = (gf_fun_def, gf_cons_args, cons_args, fun_defs, fun_heap) -retrieve_consumer_args :: !SymbIdent !*PRState -> (!Optional ConsClasses, !*PRState) -retrieve_consumer_args si=:{symb_kind} prs=:{prs_cons_args, prs_main_dcl_module_n} - # (prs_size, prs_cons_args) = usize prs_cons_args - prs = {prs & prs_cons_args = prs_cons_args} - = case symb_kind of - SK_Function {glob_module, glob_object} - | glob_module == prs_main_dcl_module_n && glob_object < prs_size - # (cons_args,prs) = prs!prs_cons_args.[glob_object] - -> (Yes cons_args,prs) - -> (No,prs) -!-> ("r_c_a",si) - SK_LocalMacroFunction glob_object - | glob_object < prs_size - # (cons_args,prs) = prs!prs_cons_args.[glob_object] - -> (Yes cons_args,prs) - -> (No,prs) -!-> ("r_c_a",si) - SK_GeneratedFunction fun_ptr fun_index - | fun_index < prs_size - # (cons_args,prs) = prs!prs_cons_args.[fun_index] - -> (Yes cons_args,prs) - # (FI_Function {gf_cons_args}, fun_heap) = readPtr fun_ptr prs.prs_fun_heap - # prs = {prs & prs_fun_heap = fun_heap} - -> (Yes gf_cons_args,prs) -// SK_Constructor cons_index - sk -> (No -!-> ("Unexpected symbol kind: ", si, sk),prs) - //@ <<< instance <<< Group where |