From 96cde0d7d16b853fa6e5a955735ce0384e5d65c1 Mon Sep 17 00:00:00 2001 From: zweije Date: Tue, 14 Aug 2001 13:42:00 +0000 Subject: This commit was generated by cvs2svn to compensate for changes in r636, which included commits to RCS files with non-trunk default branches. git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@637 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d --- sucl/newfold.icl | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) (limited to 'sucl') diff --git a/sucl/newfold.icl b/sucl/newfold.icl index f84f710..de55a0a 100644 --- a/sucl/newfold.icl +++ b/sucl/newfold.icl @@ -345,16 +345,19 @@ newextract :: newextract trc newname (Trace stricts rule answer history transf) | recursive = (stricts,[recrule],recareas) -= subex transf - where subex (Reduce reductroot trace) = newextract trc newname trace - subex (Annotate trace) = newextract trc newname trace - subex (Instantiate yestrace notrace) - = (stricts,yesrules++norules,yesareas++noareas) - where (yesstricts,yesrules,yesareas) = newextract trc newname yestrace - (nostricts,norules,noareas) = newextract trc newname notrace - subex Stop = (stricts,[mkrule rargs rroot stoprgraph],stopareas) - - (recursive,unsafearea) += case transf + of Reduce reductroot trace + -> newextract trc newname trace + Annotate trace + -> newextract trc newname trace + Instantiate yestrace notrace + -> (stricts,yesrules++norules,yesareas++noareas) + where (yesstricts,yesrules,yesareas) = newextract trc newname yestrace + (nostricts,norules,noareas) = newextract trc newname notrace + Stop + -> (stricts,[mkrule rargs rroot stoprgraph],stopareas) + + where (recursive,unsafearea) = if (isreduce transf) (foldoptional (False,undef) (findspinepart rule transf) answer) (False,abort "newextract: not a Reduce transformation") -- cgit v1.2.3