REPL commands

[Helmut Eller <eller dot helmut at gmail dot com>]

Hello,

I'd like to contribute some "commands" for the REPL:

 time: a simple profiling tool
 gc: triggers GC and prints GC related information
 room: prints memory statistics
 apropos: lists bindings

Nothing fancy, but it's a start.  Maybe those could be distributed along
with Kawa, perhaps in the gnu/kawa/slib directory.

Helmut.


;; Some "commands" supposed to be invoked directly from the REPL.

(module-export time gc room apropos)

(module-static #t)

(module-compile-options
 warn-invoke-unknown-method: #t
 warn-undefined-variable: #t
 )

;; Call FUN for each element in ITER.
(define (each (iter java.lang.Iterable) (fun function))
  (let ((iter :: java.util.Iterator (iter:iterator)))
    (do ()
	((not (iter:hasNext)))
      (fun (iter:next)))))

;; (time FORM) => RESULT 
;; Evaluate FORM and print various timing data.
;; Return the result of the evaluating FORM.
(define-syntax time
  (syntax-rules ()
    ((time form)
     (%time (lambda () form)))))

(define (%time (fun function))
  (define-alias <mf> java.lang.management.ManagementFactory)
  (define-alias <gc> java.lang.management.GarbageCollectorMXBean)
  (let* ((gcs <mf>:GarbageCollectorMXBeans)
         (mem <mf>:MemoryMXBean)
         (jit <mf>:CompilationMXBean)
         (oldjit jit:TotalCompilationTime)
         (oldgc (let ((alist '()))
		  (each gcs (lambda ((gc <gc>))
			      (set! alist `((,gc ,gc:CollectionCount 
						 ,gc:CollectionTime)
					    . ,alist))))
		  alist))
         (oldheap mem:HeapMemoryUsage:Used)
         (oldnonheap mem:NonHeapMemoryUsage:Used)
         (start (java.lang.System:nanoTime))
         (values (fun))
         (end (java.lang.System:nanoTime))
         (newheap mem:HeapMemoryUsage:Used)
         (newnonheap mem:NonHeapMemoryUsage:Used)
	 (newjit jit:TotalCompilationTime))
    (format #t "~&")
    (format #t "; JIT compilation: ~:d ms (~:d ms total)\n" 
	    (- newjit oldjit) newjit)
    (each gcs (lambda ((gc <gc>))
		(apply (lambda (count time)
			 (format #t "; GC ~a: ~:d ms (~d collections)\n"
				 gc:Name 
				 (- gc:CollectionTime time)
				 (- gc:CollectionCount count)))
		       (cdr (assoc gc oldgc)))))
    (format #t "; Heap: ~@:d (~:d)\n" (- newheap oldheap) newheap)
    (format #t "; Non-Heap: ~@:d (~:d)\n" (- newnonheap oldnonheap) newnonheap)
    (format #t "; Elapsed time: ~:d ms\n" (/ (- end start) 1000000))
    values))


;; Initiate a garbage collection.
;; If the keyword argument VERBOSE is true (the default), print various
;; GC statistics.
(define (gc #!key (verbose #t))
  (let ((mem java.lang.management.ManagementFactory:MemoryMXBean))
    (if (not verbose)
	(mem:gc)
	(let* ((oldheap mem:HeapMemoryUsage:Used)
	       (oldnonheap mem:NonHeapMemoryUsage:Used)
	       (oldverbose (mem:isVerbose))
	       (_ (begin
		    (if verbose (mem:setVerbose verbose))
		    (mem:gc)
		    (mem:setVerbose oldverbose)))
	       (newheap mem:HeapMemoryUsage:Used)
	       (newnonheap mem:NonHeapMemoryUsage:Used))
	  (format #t "; heap: ~@:d (~:d) non-heap: ~@:d (~:d)\n"
		  (- newheap oldheap) newheap 
		  (- oldnonheap newnonheap) newnonheap)))))

;; Print information about the memory system.
(define (room)
  (let* ((pools java.lang.management.ManagementFactory:MemoryPoolMXBeans)
         (mem java.lang.management.ManagementFactory:MemoryMXBean)
         (heap mem:HeapMemoryUsage)
         (nonheap mem:NonHeapMemoryUsage))
    (format #t "; Memory Pools\n")
    (each pools (lambda ((p java.lang.management.MemoryPoolMXBean))
		  (format #t "~&; ~a~1,16t: ~10:d\n" p:Name p:Usage:Used)))
    (format #t ";\n")
    (format #t "; Heap~1,16t: ~10:d (max ~10:d) \n" heap:Used heap:Max)
    (format #t "; Non-Heap~1,16t: ~10:d (max ~10:d)\n" 
	    nonheap:Used nonheap:Max)))

;; Print bindings matching PATTERN.
(define (apropos (pattern string)
		 #!key (env :: gnu.mapping.Environment
			    (interaction-environment)))
  (let ((iter (env:enumerateAllLocations)))
    (do ()
	((not (iter:hasNext)))
      (let ((loc (iter:nextLocation)))
	(when (instance? loc gnu.mapping.NamedLocation)
	  (let* ((loc :: gnu.mapping.NamedLocation loc)
		 (name loc:KeySymbol:Name))
	    (when (name:contains pattern)
	      (format #t "~a\t: ~a\n" name loc))))))))