[racket] disable inlining for recursive functions

I too have a curiosity about inlining.

In the following fragment of code, all the functions defined are used
in only one place. Optimization coach says the first and the fourth
are inlined, but not the others:

(define (posizione-accettabile? tabella pezzi)
  (and (for/or ((posizione (in-list le-posizioni)))
         (or (array-ref tabella (posizione-x posizione) (posizione-y posizione))
             (copribile? posizione pezzi tabella)))
       (for/and ((p (in-list pezzi)))
         (sistemabile? p tabella))))

(define (sistemabile? pezzo tabella)
  (for/or ((p (in-list pezzo)))
    (sistemabile-orientazione? (first p) tabella)))

(define (sistemabile-orientazione? orientazione tabella)
  (for/or ((posizione (in-list le-posizioni)))
    (compatibile? orientazione posizione tabella)))

(define (copribile? posizione pezzi tabella)
  (for/or ((pezzo (in-list pezzi)))
    (copribile-orientazione? posizione pezzo tabella)))

(define (copribile-orientazione? posizione pezzo tabella)
  (for/or ((p (in-list pezzo)))
    (compatibile? (first p) posizione tabella)))

Naively, I thought this was a no brainer for the inliner: small
functions, used only once, no complex control flow.  Why does it gives
up?

BTW, doing the inlines manually does actually make a difference in the
total running time, so It would be nice to have this done
automatically.

(Attached there's the whole, compilable, program).

Cheers
P.
-------------- next part --------------
#lang racket

(provide ris)

(require racket/date)
;(require "plivastigoj.rkt")

;;; ================================================================
;; Plivastigoj

;(define sek-al-hms-dis #\:)
(define sek-al-hms-dis " ")

(define (sek-al-hms s)
  ;(set! s (inexact->exact (round s))) 
  (let ((sek-por-u `((,(* 24 60 60) "t") (,(* 60 60) "h") (60 "m") (1 "s") (0.001 "ms"))))
    (define (fa s spec)
      (if (null? spec)
        '()
        (let* ((q (inexact->exact (truncate (/ s (caar spec)))))
               (resto (- s (* q (caar spec)))))
          (if (zero? q)
            (fa resto (cdr spec))
            (list* sek-al-hms-dis q (cadar spec)
                   (fa resto (cdr spec)))))))
    (if (zero? s)
      "0"
      (apply string-append
             (map (位 (x) (format "~a" x))
                  (cdr (fa s sek-por-u)))))))

(define (run-time)
  (* (current-inexact-milliseconds)
     #i1/1000))

;;; ================================================================

(date-display-format 'iso-8601)
(print-struct #t)

(struct sexomino
  (n e s o)
  #:transparent
  )

(struct posizione
  (x y)
  #:transparent)

;;; ***********************************

#|
(require racket/unsafe/ops)

(define-syntax posizione
  (syntax-rules ()
    ((_ x y) (cons x y))))

(define-syntax posizione-x
  (syntax-rules ()
    ((_ p) (unsafe-car p))))

(define-syntax posizione-y
  (syntax-rules ()
    ((_ p) (unsafe-cdr p))))

(define-syntax sexomino
  (syntax-rules ()
    ((_ n e s o) (vector n e s o))))

(define-syntax sexomino-n
  (syntax-rules ()
    ((_ s) (unsafe-vector-ref s 0))))

(define-syntax sexomino-e
  (syntax-rules ()
    ((_ s) (unsafe-vector-ref s 1))))

(define-syntax sexomino-s
  (syntax-rules ()
    ((_ s) (unsafe-vector-ref s 2))))

(define-syntax sexomino-o
  (syntax-rules ()
    ((_ s) (unsafe-vector-ref s 3))))

(define-syntax unsafe-first
  (syntax-rules ()
    ((_ l) (unsafe-car l))))

(define-syntax unsafe-rest
  (syntax-rules ()
    ((_ l) (unsafe-cdr l))))
|#

;;; ***********************************

(define sexomino= equal?)

(define (string->sexomino s)
  (sexomino (char->sex (string-ref s 0))
            (char->sex (string-ref s 1))
            (char->sex (string-ref s 2))
            (char->sex (string-ref s 3))))

(define (sexomino->string s)
  (string (sex->char (sexomino-n s))
          (sex->char (sexomino-e s))
          (sex->char (sexomino-s s))
          (sex->char (sexomino-o s))))

(define (char->sex c)
  (case c
    ((#\f) -1)
    ((#\n) 0)
    ((#\m) 1)))

(define (sex->char s)
  (case s
    ((-1) #\f)
    ((0) #\n)
    ((1) #\m)))

(define sexomini
  (map string->sexomino
       '("nnnn" "nfnn" "nmnn" "ffnn" "fmnn" "mfnn" "mmnn" "nfnf"
                "nmnf" "nmnm" "ffnf" "fmnf" "mfnf" "mmnf" "ffnm" "fmnm"
                "mfnm" "mmnm" "ffff" "fmff" "mmff" "fmfm" "mmfm" "mmmm")))

;;; ================================================================

(define (make-array dims (init #f))
  (let ancora ((dims dims))
    (if (null? (rest dims))
      (make-vector (first dims) init)
      (let ((v (make-vector (first dims))))
        (for ((i (in-range (first dims))))
          (vector-set! v i (ancora (rest dims))))
        v))))

(define-syntax array-ref
  (syntax-rules ()
    ((_ a e)
     (vector-ref a e))
    ((_ a e1 e2 e3 ...)
     (array-ref (vector-ref a e1) e2 e3 ...))))

(define-syntax array-set!
  (syntax-rules ()
    ((_ a e v)
     (vector-set! a e v))
    ((_ a e1 e2 e3 ...)
     (array-set! (vector-ref a e1) e2 e3 ...))))

(define (array-dimensions a)
  (let loop ((a a))
    (if (vector? a)
      (cons (vector-length a)
            (loop (vector-ref a 0)))
      '())))

(define (array-copy a rank)
  (if (= 1 rank)
    (vector-copy a)
    (let* ((len (vector-length a))
           (new (make-vector len)))
      (for ((i (in-range len)))
        (vector-set! new i (array-copy (vector-ref a i) (sub1 rank))))
      new)))

;;; ================================================================

(define (i-sexomini)
  (map tutte-le-orientazioni sexomini))

(define (ruota-90 un-sexomino)
  (sexomino (sexomino-o un-sexomino)
            (sexomino-n un-sexomino)
            (sexomino-e un-sexomino)
            (sexomino-s un-sexomino)))

(define (tutte-le-orientazioni sexomino)
  (let* ((r1 (ruota-90 sexomino))
         (r2 (ruota-90 r1))
         (r3 (ruota-90 r2)))
    (remove-duplicates (list r3 r2 r1 sexomino) sexomino=)))

(define (crea-tabella)
  (let ((tabella (make-array '(8 6) #f))
        (neutro (sexomino 0 0 0 0)))
    (for ((i (in-range 8)))
      (array-set! tabella i 0 neutro)
      (array-set! tabella i 5 neutro))
    (for ((i (in-range 6)))
      (array-set! tabella 0 i neutro)
      (array-set! tabella 7 i neutro))
    tabella))

#|
(define (posizioni-da-riempire-vecchia)
    (let ((angoli '((1 1) (1 4) (6 4) (6 1)))
          (lato-1y '((1 2) (1 3)))
          (lato-x4 '((2 4) (3 4) (4 4) (5 4)))
          (lato-6y '((6 2) (6 3)))
          (lato-x1 '((5 1) (4 1) (3 1) (2 1)))
          (pos-centrali (let ancora ((x 2) (acc '()))
                          (if (> x 5)
                            (reverse acc)
                            (ancora (+ x 1)
                                    (append (let ancora ((y 2) (acc '()))
                                              (if (> y 3)
                                                (reverse acc)
                                                (ancora (+ y 1)
                                                        (cons (list x y) acc))))
                                            acc))))))
      (for/list ((l (in-list (append angoli lato-1y lato-x4 lato-6y lato-x1 pos-centrali))))
        (apply cons l))))
|#

(define (dal-centro pos)
  (define cx 3.5)
  (define cy 2.5)
  (+ (sqr (- (posizione-x pos) cx))
     (sqr (- (posizione-y pos) cy))))

(define (posizioni-da-riempire)
  (sort (for*/list ((x (in-range 1 7))
                    (y (in-range 1 5)))
          (posizione x y))
        (位 (a b)
          (> (dal-centro a)
             (dal-centro b)))))

(define (scrivi-sexomino sexo dove)
  (display (if sexo
             (sexomino->string sexo)
             "....")
           dove))

(define (scrivi-tabella tabella (dove (current-output-port)))
  (for ((y (in-range 4 0 -1)))
    (display (if (= y 4) " (" "  ") dove)
    (for ((x (in-range 1 7)))
      (scrivi-sexomino (array-ref tabella x y) dove)
      (unless (= x 6)
        (display " " dove)))
    (unless (= y 1)
      (newline dove)))
  (display ")" dove)
  (newline dove))

(define soluzioni-trovate 
  (make-parameter 0))

(define soluzioni-da-trova 
  (make-parameter 99999999))

(define tempo-inizio 
  (make-parameter #f))

(define log-port
  (make-parameter #f))

(define (eureka tabella)
  (soluzioni-trovate (add1 (soluzioni-trovate)))
  (let ((out (log-port)))
    (fprintf out "(~s~%" (soluzioni-trovate))
    (scrivi-tabella tabella out)
    (let ((tempo-impiegato (- (run-time) (tempo-inizio))))
      (let ((tempo-per-soluzione (/ tempo-impiegato (exact->inexact (soluzioni-trovate))))
            (soluzioni-per-secondo (/ (soluzioni-trovate) tempo-impiegato)))
        (fprintf out " ~a ~a ~a ~s)~%~%"
                 (real->decimal-string tempo-impiegato 3)
                 (real->decimal-string tempo-per-soluzione 3)
                 (real->decimal-string soluzioni-per-secondo 3)
                 (sek-al-hms tempo-impiegato))
        ;(flush-output out)
        ))
    (when (>= (soluzioni-trovate) (soluzioni-da-trova))
      (raise 'basta))))

(define (compatibile? sexomino posizione tabella)
  (let ((x (posizione-x posizione))
        (y (posizione-y posizione)))
    (let ((tabella-x (vector-ref tabella x)))
      (and (not (vector-ref tabella-x y))
           (let ((qq (vector-ref tabella-x (add1 y))))
             (or (not qq)
                 (zero? (+ (sexomino-n sexomino) (sexomino-s qq)))))
           (let ((qq (array-ref tabella (add1 x) y)))
             (or (not qq)
                 (zero? (+ (sexomino-e sexomino) (sexomino-o qq)))))
           (let ((qq (vector-ref tabella-x (sub1 y))))
             (or (not qq)
                 (zero? (+ (sexomino-s sexomino) (sexomino-n qq)))))
           (let ((qq (array-ref tabella (sub1 x) y))) 
             (or (not qq)
                 (zero? (+ (sexomino-o sexomino) (sexomino-e qq)))))))))

(define (risolvi-2 sexomini)
  (let ((tabella (crea-tabella)))
    (let fansexomino ((sexomini sexomini))
      (cond ((null? sexomini)
             (eureka tabella))
            ((posizione-accettabile? tabella sexomini)
             (let ((sexomino (first sexomini)))
               (for ((orientazione (in-list sexomino)))
                 (let ((forma (first orientazione)))
                   (for ((posizione (in-list (rest orientazione))))
                     (when (compatibile? forma posizione tabella)
                       (let* ((x (posizione-x posizione))
                              (y (posizione-y posizione))
                              (v (vector-ref tabella x)))
                         (vector-set! v y forma)
                         (fansexomino (rest sexomini))
                         (vector-set! v y #f))))))))))))

(define le-posizioni (posizioni-da-riempire))

(define (posizione-accettabile? tabella pezzi)
  (and (for/or ((posizione (in-list le-posizioni)))
         (or (array-ref tabella (posizione-x posizione) (posizione-y posizione))
             (copribile? posizione pezzi tabella)))
       (for/and ((p (in-list pezzi)))
         (sistemabile? p tabella))))

(define (sistemabile? pezzo tabella)
  (for/or ((p (in-list pezzo)))
    (sistemabile-orientazione? (first p) tabella)))

(define (sistemabile-orientazione? orientazione tabella)
  (for/or ((posizione (in-list le-posizioni)))
    (compatibile? orientazione posizione tabella)))

(define (copribile? posizione pezzi tabella)
  (for/or ((pezzo (in-list pezzi)))
    (copribile-orientazione? posizione pezzo tabella)))

(define (copribile-orientazione? posizione pezzo tabella)
  (for/or ((p (in-list pezzo)))
    (compatibile? (first p) posizione tabella)))

(define (date-and-time)
  (date->string (seconds->date (current-seconds)) #t))

(define (ris (log (current-output-port)))
  (cond ((output-port? log)
         (parameterize ((log-port log)
                        (tempo-inizio (run-time))
                        (soluzioni-trovate 0))
           (ris-port)))
        ((string? log)
         (call-with-output-file log ris #:exists 'replace))
        (else
         (error "eh?"))))

(define (ris-port)
  (let ((log-port (log-port)))
    (fprintf log-port ";; -*- mode: scheme -*-~%~%")
    (fprintf log-port ";; ~A~%~%" (date-and-time))
    (let* ((sexomini (i-sexomini))
           (tabella (crea-tabella))
           (sexomini-giro-posizionati
            (for/list ((orientazioni (in-list sexomini)))
              (for/list ((orientazione (in-list orientazioni)))
                (cons orientazione
                      (filter (位 (pos)
                                (compatibile? orientazione pos tabella))
                              le-posizioni)))))
           (sexomini-potati (filtro-statico sexomini-giro-posizionati)))
      (with-handlers (((位 (e) (eq? e 'basta))
                       (位 (e) e)))
        (risolvi-2 sexomini-potati)))
    (fprintf log-port "~A~%~%" (- (run-time) (tempo-inizio)))
    (fprintf log-port ";; ~A~%~%" (date-and-time))
    (flush-output log-port)))

(define (possibilita-totali-sexomino sexomino)
  (apply + (map length sexomino)))

(define (filtro-statico sexomini)
  (let* ((prima-forma (caar sexomini))
         (prima-potata
          (cons (first prima-forma)
                ;; restringe a pos non centrali.
                (filter-not centrale?
                            ;; restringe a un quarto.
                            (filter (位 (x)  
                                      (and (<= (posizione-x x) 3)
                                           (<= (posizione-y x) 2)))
                                    (rest prima-forma)))))
         (altre-potate
          (sort (map (位 (lista-di-orientazioni)
                       (if (= 3 (quanti-sex (caar lista-di-orientazioni)))
                         (map (位 (orientazione)
                                (cons (first orientazione)
                                      (filter-not centrale?
                                                  (rest orientazione))))
                              lista-di-orientazioni)
                         lista-di-orientazioni))
                     (rest sexomini))
                (位 (a b)
                  (< (possibilita-totali-sexomino a)
                     (possibilita-totali-sexomino b))))))
    (cons (list prima-potata)
          altre-potate)))

(define (centrale? pos)
  (and (<= 2 (posizione-x pos) 5)
       (<= 2 (posizione-y pos) 3)))

(define (quanti-sex sexo)
  (length (filter-not zero?
                      (list (sexomino-n sexo)
                            (sexomino-e sexo)
                            (sexomino-s sexo)
                            (sexomino-o sexo)))))

(define (invertito un-sexomino)
  (sexomino (- (sexomino-n un-sexomino))
            (- (sexomino-e un-sexomino))
            (- (sexomino-s un-sexomino))
            (- (sexomino-o un-sexomino))))

(define (soluzione-invertita tabella)
  (let ((dim (array-dimensions tabella))
        (new (array-copy tabella 2)))
    (for ((x (in-range (first dim))))
      (let ((row (vector-ref new x)))
        (for ((y (in-range (second dim))))
          (vector-set! row y (invertito (vector-ref row y))))))
    new))

'(let ((cl (current-command-line-arguments)))
  (apply ris (vector->list cl)))