bug#38486: Compiler does not terminate

bug#38486: Compiler does not terminate

[Zack Marvel]

Hello,

When compiling the following program, the compiler does not terminate.


(define (find-closest-intersection board)
   (let ((cols (vector-length board))
	(rows (vector-length (vector-ref board 0))))
     (let col-loop ((col 0)
		   (min-distance 999))
       (if (< col cols)
	  (col-loop
	   (1+ col)
	   (let row-loop ((row 0)
			  (min-distance min-distance))
	     (if (< row rows)
		 (row-loop (1+ row) min-distance)
		 min-distance)))
	  min-distance))))


Here is the output of the compiler:


$ guile ~/src/advent-of-code/2019/guile_infinite_loop.scm
;;; note: source file 
/home/zack/src/advent-of-code/2019/guile_infinite_loop.scm
;;;       newer than compiled 
/home/zack/.local/src/guile-2.2.6/cache/guile/ccache/2.2-LE-8-3.A/home/zack/src/advent-of-code/2019/guile_infinite_loop.scm.go
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;       or pass the --no-auto-compile argument to disable.
;;; compiling /home/zack/src/advent-of-code/2019/guile_infinite_loop.scm


If I flatten the two loops into one, the program compiles. If I use 
constants instead of vector sizes, it also compiles.

I can produce this behavior with Guile 2.2.4 and 2.2.6. I'm running 
Debian 10 amd64, and I compiled Guile with GCC 8.3.0.

Please let me know if I can provide more information!

Best regards,
Zack Marvel

bug#38486: Compiler does not terminate

[tomas]

[-- Attachment #1: Type: text/plain, Size: 754 bytes --]

On Tue, Dec 03, 2019 at 09:58:00PM -0700, Zack Marvel wrote:
> Hello,
> 
> When compiling the following program, the compiler does not terminate.

[...]

> I can produce this behavior with Guile 2.2.4 and 2.2.6. I'm running
> Debian 10 amd64, and I compiled Guile with GCC 8.3.0.

FWIW, I just tried with guile 2.9.5 and the compile terminates:

  tomas@trotzki:~$ guile /tmp/zack.scm 
  ;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
  ;;;       or pass the --no-auto-compile argument to disable.
  ;;; compiling /tmp/zack.scm
  ;;; compiled /home/tomas/.cache/guile/ccache/3.0-LE-8-4.1/tmp/zack.scm.go

(after having saved your file to /tmp/zack.scm, that is).

So another data point, I assume :-)

Cheers
-- t

[-- Attachment #2: Digital signature --]
[-- Type: application/pgp-signature, Size: 198 bytes --]

bug#38486: compile livelock

[Matt Wette]

I reproduced the behavior on 2.2.7.   I also found that -O0 and -O1 do 
not have a problem:

$ meta/guild compile -O0 38486-1.scm -o 38486-1.go
wrote `38486-1.go'

$ meta/guild compile -O1 38486-1.scm -o 38486-1.go
wrote `38486-1.go'

$ meta/guild compile -O2 38486-1.scm -o 38486-1.go
^Cerror: interrupted by the user

bug#38486: try all options

[Matt Wette]

The behavior is that guild compile 38486-1.scm hangs

These optimization flags eliminate that behavior: the code compiles quickly:
  -O0
  -O1
  -Ono-simplify
  -Ono-contify
  -Ono-cse
  -Ono-specialize-numbers

These optimization flags are ineffective: the behavior remains:
  -Ono-partial-eval
  -Ono-eliminate-dead-code
  -Ono-prune-top-level-scopes
  -Ono-inline-constructors
  -Ono-specialize-primcalls
  -Ono-elide-values
  -Ono-prune-bailouts
  -Ono-peel-loops
  -Ono-type-fold
  -Ono-resolve-self-references
  -Ono-licm
  -Ono-rotate-loops
  -Ono-precolor-calls

bug#38486: hang

[Matt Wette]

So I hacked modules/cps/optimize.scm to display the optimization phases.

Here is what I got up to the point where guile hangs.
It looks like it's hanging in specialize-numbers.

running eliminate-dead-code
running prune-top-level-scopes
running simplify
running contify
running inline-constructors
running elide-values
running prune-bailouts
running peel-loops
running eliminate-common-subexpressions
running type-fold
running resolve-self-references
running eliminate-dead-code
running simplify
running specialize-numbers

The patch:
--- module/language/cps/optimize.scm-orig    2020-03-21 
14:16:17.313452995 -0700
+++ module/language/cps/optimize.scm    2020-03-21 14:18:32.264770889 -0700
@@ -73,7 +73,10 @@
      (maybe-verify program)
      (set! program
        (if (kw-arg-ref opts kw default)
-          (maybe-verify (pass program))
+          (begin
+            (display "running ") (display (quote pass)) (newline)
+            (force-output (current-output-port))
+            (maybe-verify (pass program)))
            program))
      ...
      (maybe-verify program)))

bug#38486: specialize-numbers.scm: compute-significant-bits

[Matt Wette]

I've narrowed it down to the named let loop "lp" in this routine in
module/language/cps/specialize-numbers.scm


(define (compute-significant-bits cps types kfun)
   "Given the locally inferred types @var{types}, compute a map of VAR ->
BITS indicating the significant bits needed for a variable.  BITS may be
#f to indicate all bits, or a non-negative integer indicating a bitmask."
   (let ((preds (invert-graph (compute-successors cps kfun))))
     (let lp ((worklist (intmap-keys preds)) (visited empty-intset)
              (out empty-intmap))
       (match (intset-prev worklist)
         (#f out)
         (label
          (let ((worklist (intset-remove worklist label))
                (visited* (intset-add visited label)))
            (define (continue out*)
              (if (and (eq? out out*) (eq? visited visited*))
                  (lp worklist visited out)
                  (lp (intset-union worklist (intmap-ref preds label))
                      visited* out*)))
            (define (add-def out var)
              (intmap-add out var 0 sigbits-union))
            (define (add-defs out vars)
              (match vars
                (() out)
                ((var . vars) (add-defs (add-def out var) vars))))
            (define (add-unknown-use out var)
              (intmap-add out var (inferred-sigbits types label var)
                          sigbits-union))
            (define (add-unknown-uses out vars)
              (match vars
                (() out)
                ((var . vars)
                 (add-unknown-uses (add-unknown-use out var) vars))))
            (continue
             (match (intmap-ref cps label)
               (($ $kfun src meta self)
                (add-def out self))
               (($ $kargs names vars ($ $continue k src exp))
                (let ((out (add-defs out vars)))
                  (match exp
                    ((or ($ $const) ($ $prim) ($ $fun) ($ $closure) ($ 
$rec))
                     ;; No uses, so no info added to sigbits.
                     out)
                    (($ $values args)
                     (match (intmap-ref cps k)
                       (($ $kargs _ vars)
                        (if (intset-ref visited k)
                            (fold (lambda (arg var out)
                                    (intmap-add out arg (intmap-ref out var)
                                                sigbits-union))
                                  out args vars)
                            out))
                       (($ $ktail)
                        (add-unknown-uses out args))))
                    (($ $call proc args)
                     (add-unknown-use (add-unknown-uses out args) proc))
                    (($ $callk label proc args)
                     (add-unknown-use (add-unknown-uses out args) proc))
                    (($ $branch kt ($ $values (arg)))
                     (add-unknown-use out arg))
                    (($ $branch kt ($ $primcall name args))
                     (add-unknown-uses out args))
                    (($ $primcall name args)
                     (let ((h (significant-bits-handler name)))
                       (if h
                           (match (intmap-ref cps k)
                             (($ $kargs _ defs)
                              (h label types out args defs)))
                           (add-unknown-uses out args))))
                    (($ $prompt escape? tag handler)
                     (add-unknown-use out tag)))))
               (_ out)))))))))

bug#38486: done

[Matt Wette]

fixed by wingo:

$ git log -1
commit ef6f7ce70bfb9310cfec2a87a0a26ad7b9ab355b (HEAD -> master, origin/master, origin/HEAD)
Author: Andy Wingo <wingo@pobox.com>
Date:   Mon Mar 23 14:45:29 2020 +0100

     Fix fixpoint computation in compute-significant-bits
     
     * module/language/cps/specialize-numbers.scm (preserve-eq?): New
       helper.
       (sigbits-union): Use the new helper.  Fixes bugs.gnu.org/38486.
       Thanks to Zack Marvel for the bug report and Matt Wette for tracking
       it down.