>From 48bd1e253fd03b7b37e91d1bf3c6f23b66ee308f Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sun, 22 Jan 2012 17:58:54 +0100
Subject: [PATCH] Limit depth for procedure nesting reports to ensure linear scaling of compilation times on input file size.
 More than 10 doesn't produce very useful/readable output anyway, so that's a good default.
 Provide compiler switch to set higher limit or to remove it altogether.

---
 NEWS             |    2 ++
 batch-driver.scm |    5 +++++
 c-platform.scm   |    2 +-
 csc.scm          |    4 +++-
 support.scm      |   25 +++++++++++++++++--------
 5 files changed, 28 insertions(+), 10 deletions(-)

diff --git a/NEWS b/NEWS
index 262a063..acc188f 100644
--- a/NEWS
+++ b/NEWS
@@ -72,6 +72,8 @@
   - various improvements in the flow-analysis pass have been done and
     countless bugs fixed
   - deprecated the "constant" declaration specifier
+  - limit reporting depth of procedure nesting so C translation time scales
+    linearly on file size, tweakable through new "-report-max-nesting" option
 
 - Type system
   - added new type-specifiers "input-port", "output-port", "(list-of T)" 
diff --git a/batch-driver.scm b/batch-driver.scm
index 65650a7..b7bf3af 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -246,6 +246,11 @@
 	(let ([arg (option-arg inlimit)])
 	  (or (string->number arg)
 	      (quit "invalid argument to `-inline-limit' option: `~A'" arg) ) ) ) )
+    (and-let* ((depth (memq 'report-max-nesting options)))
+      (set! real-name-max-depth
+        (let ((arg (option-arg depth)))
+          (or (string->number arg)
+              (quit "invalid argument to `-report-max-nesting' option: `~A'" arg) ) ) ) )
     (when (memq 'case-insensitive options) 
       (dribble "Identifiers and symbols are case insensitive")
       (register-feature! 'case-insensitive)
diff --git a/c-platform.scm b/c-platform.scm
index 52b2161..79b8125 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -105,7 +105,7 @@
     emit-import-library emit-inline-file static-extension consult-inline-file
     emit-type-file
     heap-growth heap-shrinkage heap-initial-size ; DEPRECATED
-    ffi-define ffi-include-path) )
+    ffi-define ffi-include-path report-max-nesting) )
 
 
 ;;; Standard and extended bindings:
diff --git a/csc.scm b/csc.scm
index 6572b67..4f79e05 100644
--- a/csc.scm
+++ b/csc.scm
@@ -152,7 +152,7 @@
     -heap-growth -heap-shrinkage -heap-initial-size ; DEPRECATED
     -consult-inline-file
     -emit-import-library
-    -no-feature))
+    -no-feature -report-max-nesting))
 
 (define-constant shortcuts
   '((-h "-help")
@@ -366,6 +366,8 @@ Usage: #{csc} FILENAME | OPTION ...
                                     file
     -S  -scrutinize                perform local flow analysis
     -types FILENAME                load additional type database
+    -report-max-nesting NUMBER     maximum depth of \"x in y in z\" messages
+                                    and comments in C code (0 means no limit)
 
   Optimization options:
 
diff --git a/support.scm b/support.scm
index 191ae7c..46d9af1 100644
--- a/support.scm
+++ b/support.scm
@@ -1395,6 +1395,8 @@
 ;     <variable-alias> -> <variable>
 ;     <lambda-id> -> <variable> or <variable-alias>
 
+(define real-name-max-depth 10)
+
 (define (set-real-name! name rname)
   (##sys#hash-table-set! real-name-table name rname) )
 
@@ -1409,15 +1411,20 @@
     (cond [(not rn) (##sys#symbol->qualified-string var)]
 	  [(pair? db)
 	   (let ([db (car db)])
-	     (let loop ([nesting (list (##sys#symbol->qualified-string rn))] 
+	     (let loop ([nesting (list (##sys#symbol->qualified-string rn))]
+                        [depth 1]
 			[container (get db var 'contained-in)] )
-	       (if container
-		   (let ([rc (resolve container)])
-		     (if (eq? rc container)
-			 (string-intersperse (reverse nesting) " in ")
-			 (loop (cons (symbol->string rc) nesting)
-			       (get db container 'contained-in) ) ) )
-		   (string-intersperse (reverse nesting) " in ")) ) ) ]
+	       (cond
+                ((> depth real-name-max-depth 0)
+                 (string-intersperse (reverse (cons "..." nesting)) " in "))
+                (container
+                 (let ([rc (resolve container)])
+                   (if (eq? rc container)
+                       (string-intersperse (reverse nesting) " in ")
+                       (loop (cons (symbol->string rc) nesting)
+                             (fx+ depth 1)
+                             (get db container 'contained-in) ) ) ))
+                (else (string-intersperse (reverse nesting) " in "))) ) ) ]
 	  [else (##sys#symbol->qualified-string rn)] ) ) )
 
 (define (real-name2 var db)
@@ -1658,6 +1665,8 @@ Usage: chicken FILENAME OPTION ...
     -scrutinize                  perform local flow analysis for static checks
     -types FILENAME              load additional type database
     -emit-type-file FILENAME     write type-declaration information into file
+    -report-max-nesting NUMBER   maximum depth of \"x in y in z\" messages
+                                  and comments in C code (0 means no limit)
 
   Optimization options:
 
-- 
1.7.3.4