diff options
Diffstat (limited to 'frontend')
| -rw-r--r-- | frontend/refmark.icl | 46 | ||||
| -rw-r--r-- | frontend/syntax.dcl | 5 |
2 files changed, 39 insertions, 12 deletions
diff --git a/frontend/refmark.icl b/frontend/refmark.icl index 4767c8f..54fbc83 100644 --- a/frontend/refmark.icl +++ b/frontend/refmark.icl @@ -22,7 +22,7 @@ fullRefMarkOfRootOrLetExpr free_vars sel def expr rms_counted_let_vars var_heap = refMark free_vars sel def expr {rms_var_heap=var_heap, rms_let_vars=[], rms_counted_let_vars=rms_counted_let_vars} rms_var_heap = openLetVars rms_let_vars rms_var_heap (closed_let_vars,rms) = addParRefMarksOfLets rms_let_vars ([],{rms_let_vars=[],rms_counted_let_vars=rms_counted_let_vars,rms_var_heap=rms_var_heap}) - = rms + = {rms & rms_counted_let_vars=closed_let_vars++rms.rms_counted_let_vars} fullRefMarkOfAlternative :: ![[FreeVar]] !Int !(Optional [CountedFreeVar]) !expr !*VarHeap -> (!*[FreeVar],!*RMState) | refMark expr fullRefMarkOfAlternative free_vars sel def expr var_heap @@ -57,6 +57,32 @@ where (occurrences, rms_var_heap) = restoreOccurrences free_vars rms_var_heap = ((occurrences, rms_let_vars),rms_counted_let_vars,rms_var_heap) +remove_local_let_vars_from_counted_let_vars :: ![FreeVar] ![FreeVar] !*VarHeap -> (![FreeVar],!*VarHeap) +remove_local_let_vars_from_counted_let_vars local_let_vars counted_let_vars var_heap + # var_heap = foldSt (\ {fv_info_ptr} -> mark_bind fv_info_ptr) local_let_vars var_heap + (counted_let_vars,var_heap) = remove_marked_local_let_vars counted_let_vars var_heap + var_heap = foldSt (\ {fv_info_ptr} -> unmark_bind fv_info_ptr) local_let_vars var_heap + = (counted_let_vars,var_heap) +where + mark_bind fv_info_ptr var_heap + # (VI_Occurrence occ,var_heap) = readPtr fv_info_ptr var_heap + = writePtr fv_info_ptr (VI_Occurrence {occ & occ_bind=OB_MarkedLet occ.occ_bind}) var_heap + + remove_marked_local_let_vars [closed_let_var:closed_let_vars] var_heap + # (VI_Occurrence occ) = sreadPtr closed_let_var.fv_info_ptr var_heap + = case occ.occ_bind of + OB_MarkedLet _ + -> remove_marked_local_let_vars closed_let_vars var_heap + _ + # (closed_let_vars,var_heap) = remove_marked_local_let_vars closed_let_vars var_heap + -> ([closed_let_var:closed_let_vars],var_heap) + remove_marked_local_let_vars [] var_heap + = ([],var_heap) + + unmark_bind fv_info_ptr var_heap + # (VI_Occurrence occ=:{occ_bind=OB_MarkedLet occ_bind},var_heap) = readPtr fv_info_ptr var_heap + = writePtr fv_info_ptr (VI_Occurrence {occ & occ_bind=occ_bind}) var_heap + instance refMark [a] | refMark a where refMark free_vars sel _ list rms @@ -221,18 +247,18 @@ where refMark free_vars sel _ (fun @ args) rms = refMark free_vars NotASelector No args (refMark free_vars NotASelector No fun rms) - refMark free_vars sel def (Let {let_strict_binds,let_lazy_binds,let_expr}) rms=:{rms_counted_let_vars,rms_var_heap} + refMark free_vars sel def (Let {let_strict_binds,let_lazy_binds,let_expr}) rms=:{rms_counted_let_vars,rms_var_heap} | isEmpty let_lazy_binds # local_let_vars = [lb_dst \\ {lb_dst} <- let_strict_binds] # new_free_vars = [local_let_vars : free_vars] - # (observing, rms_var_heap) = binds_are_observing let_strict_binds rms_var_heap - | observing + | binds_are_observing let_strict_binds rms_var_heap # rms_var_heap = saveOccurrences free_vars rms_var_heap rms = refMark new_free_vars NotASelector No let_strict_binds {rms & rms_var_heap = rms_var_heap} rms_var_heap = saveOccurrences new_free_vars rms.rms_var_heap {rms_var_heap,rms_let_vars,rms_counted_let_vars} = fullRefMarkOfRootOrLetExpr new_free_vars sel def let_expr rms_counted_let_vars rms_var_heap rms_var_heap = let_combine free_vars rms_var_heap + (rms_counted_let_vars,rms_var_heap) = remove_local_let_vars_from_counted_let_vars local_let_vars rms_counted_let_vars rms_var_heap = {rms_var_heap=rms_var_heap, rms_let_vars=rms_let_vars ++ rms.rms_let_vars, rms_counted_let_vars=rms_counted_let_vars} ===> ("refMark (Let (observing))", hd new_free_vars) = refMark new_free_vars sel def let_expr (refMark new_free_vars NotASelector No let_strict_binds {rms & rms_var_heap = rms_var_heap}) @@ -243,14 +269,14 @@ where (rms_counted_let_vars,rms_var_heap) = ref_mark_of_lets new_free_vars all_binds rms_counted_let_vars rms_var_heap {rms_var_heap,rms_let_vars,rms_counted_let_vars} = fullRefMarkOfRootOrLetExpr new_free_vars sel def let_expr rms_counted_let_vars rms_var_heap + (rms_counted_let_vars,rms_var_heap) = remove_local_let_vars_from_counted_let_vars local_let_vars rms_counted_let_vars rms_var_heap = {rms_var_heap=rms_var_heap, rms_let_vars=rms_let_vars ++ rms.rms_let_vars, rms_counted_let_vars=rms_counted_let_vars} where - binds_are_observing binds var_heap - = foldSt bind_is_observing binds (True, var_heap) - where - bind_is_observing {lb_dst={fv_info_ptr}} (observing, var_heap) - # (VI_Occurrence {occ_observing=(observe,attr)}, var_heap) = readPtr fv_info_ptr var_heap - = (observing && observe, var_heap) + binds_are_observing [{lb_dst={fv_info_ptr}}:binds] var_heap + # (VI_Occurrence {occ_observing=(is_observing,_)}) = sreadPtr fv_info_ptr var_heap + = is_observing && binds_are_observing binds var_heap + binds_are_observing [] var_heap + = True let_combine free_vars var_heap = foldSt (foldSt let_combine_ref_count) free_vars var_heap diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl index e0c3f90..b182073 100644 --- a/frontend/syntax.dcl +++ b/frontend/syntax.dcl @@ -1113,8 +1113,9 @@ instance toString KindInfo } :: OccurrenceBinding = OB_Empty - | OB_OpenLet FreeVar (Optional RefMarkResult) - | OB_LockedLet OccurrenceBinding + | OB_OpenLet !FreeVar !(Optional RefMarkResult) + | OB_LockedLet !OccurrenceBinding + | OB_MarkedLet !OccurrenceBinding :: RefMarkResult :== ([CountedFreeVar], [FreeVar]) |