Merge pull request #538 from justinethier/issue-534-tail-call-fixes

Issue 534 tail call fixes

CHANGELOG.md

@@ -4,6 +4,10 @@
 
 Bug Fixes
 
+- Fixed a beta expansion optimization bug where code such as the following would cause the compiler to hang. Thanks to Yorick Hardy for the bug report:
+
+      (define (compile-forever x) x (compile-forever x))
+
 - Added a fix from Yorick Hardy to define `*ai-v4mapped*` to zero on platforms where `AI_V4MAPPED` is undefined.
 - Updated `sqrt` to properly handle complex results given non-complex input. EG: `(sqrt -1) ==> 1i`. And updated the parser to properly handle `+i` and `-i`. Thanks to Christopher Hebert for the bug reports!
 

runtime.c

@@ -7538,6 +7538,8 @@ static int _read_is_numeric(const char *tok, int len)
 {
   return (len &&
           ((isdigit(tok[0])) ||
+           (((len == 2) && tok[1] == 'i') 
+            && (tok[0] == '-' || tok[0] == '+')) ||
            ((len > 1) && tok[0] == '.' && isdigit(tok[1])) ||
            ((len > 1) && (tok[1] == '.' || isdigit(tok[1]))
             && (tok[0] == '-' || tok[0] == '+'))));

scheme/cyclone/cps-optimizations.sld

@@ -1665,7 +1665,7 @@
 
     ;; Full beta expansion phase, make a pass over all of the program's AST
     (define (opt:beta-expand exp)
-;(write `(DEBUG opt:beta-expand ,exp)) (newline)
+      ;(trace:info `(opt:beta-expand ,exp)) (flush-output-port)
       (cond
        ((ast:lambda? exp)
         (ast:%make-lambda
@@ -1694,6 +1694,7 @@
        (else exp)))
 
     (define (analyze-cps exp)
+      ;(trace:info `(analyze-cps ,exp))
       (analyze:find-named-lets exp)
       (analyze:find-direct-recursive-calls exp)
       (analyze:find-recursive-calls exp)
@@ -2230,11 +2231,17 @@
       (scan (if->then exp) def-sym)
       (scan (if->else exp) def-sym))
      ((app? exp)
-      (when (equal? (car exp) def-sym)
-        (trace:info `("recursive call" ,exp))
-        (with-var! def-sym (lambda (var)
-          (adbv:set-self-rec-call! var #t)))
-        ))
+      ;(trace:info `(analyze:find-recursive-calls scan app ,exp))
+      (cond
+        ((equal? (car exp) def-sym)
+         (trace:info `("recursive call" ,exp))
+         (with-var! def-sym (lambda (var)
+           (adbv:set-self-rec-call! var #t))))
+        (else
+          (for-each
+            (lambda (e)
+              (scan e def-sym))
+            exp))))
      (else #f)))
 
   ;; TODO: probably not good enough, what about recursive functions that are not top-level??