fix bug that may occur if a let variable is used in another let in an alternative

of a case and is also used in another alternative,
these lets were not added to the list of lets closed by cases,
now they are, and the let will be reopened in the other alternative


git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@1751 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

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])