(use-modules (ice-9 match)
             (statprof)
             (charting prof)
             (ice-9 time)
             (srfi srfi-43)
             (system base target)
             (system base message))


(use-modules (language tree-il optimize)
             (language cps optimize)
             (language cps renumber)
             (language cps split-rec)
             (language cps compile-bytecode))

(define %default-optimizations
  ;; Default optimization options (equivalent to -O2 on Guile 2.2).
  (append (tree-il-default-optimization-options)
          (cps-default-optimization-options)))

(define %lightweight-optimizations
  ;; Lightweight optimizations (like -O0, but with partial evaluation).
  (let loop ((opts %default-optimizations)
             (result '()))
    (match opts
      (() (reverse result))
      ((#:partial-eval? _ rest ...)
       (loop rest `(#t #:partial-eval? ,@result)))
      ((kw _ rest ...)
       (loop rest `(#f ,kw ,@result))))))

(define big-cps
  (call-with-input-file "t.cps"
    (lambda (port)
      ((@@ (language cps spec) read-cps) port '()))))

(define-syntax-rule (intmap-min m) (struct-ref m 0))
(define-syntax-rule (intmap-shift m) (struct-ref m 1))
(define-syntax-rule (intmap-root m) (struct-ref m 2))

(define (intmap-vector-count m)
  (let loop ((vector (intmap-root m))
             (total 0))
    (if (vector? vector)
        (vector-fold (lambda (idx result item)
                       (if (vector? item)
                           (loop item (+ 1 result))
                           result))
                     total
                     vector)
        total)))

(define (intmap-depth m)
  (let loop ((vector (intmap-root m))
             (depth 0))
    (if (vector? vector)
        (vector-fold (lambda (idx result item)
                       (if (vector? item)
                           (max result
                                (loop item (+ 1 depth)))
                           result))
                     depth
                     vector)
        depth)))

(pk 'go!)

;; (statprof-start)
(let ((cps ((@@ (language cps compile-bytecode) lower-cps)
            big-cps %lightweight-optimizations)))
  (statprof
   (lambda ()
     ((@@ (language cps compile-bytecode) emit-bytecode)
      cps '() %lightweight-optimizations)
     ;; (compile-bytecode big-cps '() %lightweight-optimizations)
     )
   #:count-calls? #t))
;; (statprof-stop)

;; (chartprof "t.png")