Racket: Make 'report-name-base' optional in calls to 'call-with-tracer'

2 files changed, 56 insertions, 22 deletions

diff --git a/bindings/racket/main.rkt b/bindings/racket/main.rkt
index e4db143..924e28d 100644
--- a/bindings/racket/main.rkt
+++ b/bindings/racket/main.rkt
@@ -87,6 +87,7 @@ manipulate the structs as tagged pointers. |#
 
 ;; Import library functions.
 (define-ppamltracer ppaml_tracer_init (_fun _tracer _path ~> _int))
+(define-ppamltracer ppaml_tracer_init_from_env (_fun _tracer ~> _int))
 (define-ppamltracer ppaml_tracer_done (_fun _tracer ~> _int))
 (define-ppamltracer ppaml_phase_init (_fun _tracer _phase _string ~> _int))
 (define-ppamltracer ppaml_phase_done (_fun _phase ~> _int))
@@ -179,6 +180,11 @@ constructor at all. |#
 
 (define-exception exn:fail:ppamltracer)
 
+(define-exception exn:fail:ppamltracer:configuration)
+
+(define-exception exn:fail:ppamltracer:configuration:undefined-tracer-base-path
+  "attempted to configure tracer with undefined base path")
+
 (define-exception exn:fail:ppamltracer:otf)
 
 (define-exception exn:fail:ppamltracer:otf:manager)
@@ -258,15 +264,22 @@ This is a bug in ppamltracer!  Report it to the maintainers."
 (define ((as-void proc) . args)
   (void (apply proc args)))
 
-(define ppaml-tracer-init
-  (as-void
-   (checked ppaml_tracer_init
-            [0 'ok]
-            [1 (fail make-exn:fail:ppamltracer:otf:manager:initialization)]
-            [2 (fail make-exn:fail:ppamltracer:otf:writer:initialization)]
-            [3 (fail make-exn:fail:ppamltracer:otf:writer:resolution)]
-            [4 (fail make-exn:fail:ppamltracer:otf:writer:process-definition
-                     "main")])))
+(define (ppaml-tracer-init tracer [path 'from-environment])
+  (let-values ([(c-initialize c-initialize-args)
+                (if (equal? path 'from-environment)
+                    (values ppaml_tracer_init_from_env (list tracer))
+                    (values ppaml_tracer_init (list tracer path)))])
+    (apply
+     (as-void
+      (checked
+       c-initialize
+       [0 'ok]
+       [1 (fail make-exn:fail:ppamltracer:otf:manager:initialization)]
+       [2 (fail make-exn:fail:ppamltracer:otf:writer:initialization)]
+       [3 (fail make-exn:fail:ppamltracer:otf:writer:resolution)]
+       [4 (fail make-exn:fail:ppamltracer:otf:writer:process-definition "main")]
+       [5 (fail make-exn:fail:ppamltracer:configuration:undefined-tracer-base-path)]))
+     c-initialize-args)))
 
 (define ppaml-tracer-done
   (as-void
@@ -344,13 +357,19 @@ evaluates to
     (finalize resource)
     result))
 
-(define (call-with-tracer report-name-base proc)
+(define (call-with-tracer-explicitly report-name-base proc)
   (managed-execution (malloc-_tracer)
                      ppaml-tracer-init
                      (list report-name-base)
                      proc
                      ppaml-tracer-done))
 
+(define call-with-tracer
+  (case-lambda
+    [(proc) (call-with-tracer-explicitly 'from-environment proc)]
+    [(report-name-base proc)
+     (call-with-tracer-explicitly report-name-base proc)]))
+
 (define (call-with-phase tracer phase-name proc)
   (managed-execution (malloc-_phase)
                      (lambda (phase tracer name)
@@ -370,8 +389,12 @@ evaluates to
 
 ;;;;; Macro versions ;;;;;
 
-(define-syntax-rule (let/tracer [tracer report-name-base] body ...)
-  (call-with-tracer report-name-base (lambda (tracer) body ...)))
+(define-syntax let/tracer
+  (syntax-rules ()
+    [(_ [tracer] body ...)
+     (call-with-tracer (lambda (tracer) body ...))]
+    [(_ [tracer report-name-base] body ...)
+     (call-with-tracer report-name-base (lambda (tracer) body ...))]))
 
 (define-syntax-rule (let/phase tracer [phase phase-name] body ...)
   (call-with-phase tracer phase-name (lambda (phase) body ...)))
@@ -385,8 +408,11 @@ evaluates to
 (provide
  (contract-out [tracer? (-> any/c boolean?)]
                [phase? (-> any/c boolean?)]
+               ;; TODO: update
                [call-with-tracer (parametric->/c [A]
-                                   (-> path-string? (-> tracer? A) A))]
+                                   (case->
+                                    (-> (-> tracer? A) A)
+                                    (-> path-string? (-> tracer? A) A)))]
                [call-with-phase (parametric->/c [A]
                                   (-> tracer? string? (-> phase? A) A))]
                [call-with-phase-running (parametric->/c [A]
diff --git a/bindings/racket/manual.scrbl b/bindings/racket/manual.scrbl
index f27731b..2938965 100644
--- a/bindings/racket/manual.scrbl
+++ b/bindings/racket/manual.scrbl
@@ -110,21 +110,29 @@ ppamltracer is fundamentally a set of stateful operations; the @racket[tracer] d
   Evaluates to @racket[#t] if and only if @racket[obj] is a @racket[tracer].
 }
 
-@defproc[(call-with-tracer [report-name-base path-string?]
-                           [proc (-> tracer? A)])
-         A]{
+@defproc*[([(call-with-tracer [proc (-> tracer? A)])
+            A]
+           [(call-with-tracer [report-name-base path-string?]
+                              [proc (-> tracer? A)])
+            A])]{
   Creates a new @racket[tracer].
-  The @racket[tracer] will save trace reports in Open Trace Format; all trace file paths will begin with @racket[report-name-base].
+  The @racket[tracer] will save trace reports in Open Trace Format.
+  Should @racket[report-name-base] be specified, all trace file paths will begin with @racket[report-name-base]; otherwise, all trace file paths will begin with the contents of the environment variable @envvar{PPAMLTRACER_TRACE_BASE}.
+
+  Invoking @racket[call-with-tracer] without specifying @racket[report-name-base] is an error if @envvar{PPAMLTRACER_TRACE_BASE} is undefined.
+  Doing so will cause Racket to throw (a sub-exception of) @racket[exn:fail:ppamltracer:configuration].
 }
 
-@defform[#:id let/tracer
-         #:literals (tracer)
-         (let/tracer [tracer report-name-base] body ...)
-         #:contracts ([report-name-base path-string?])]{
+@defform*[#:id let/tracer
+          #:literals (tracer)
+          [(let/tracer [tracer] body ...)
+           (let/tracer [tracer report-name-base] body ...)]
+          #:contracts ([report-name-base path-string?])]{
   Macro version of @racket[call-with-tracer].
-  Equivalent to
+  Equivalent to one of
 
   @racketblock[
+  (call-with-tracer (lambda (tracer) body ...))
   (call-with-tracer report-name-base (lambda (tracer) body ...))
   ]
 }