Permalink
Browse files

fixing the logs so we don't run into format errors

  • Loading branch information...
1 parent b7ebab1 commit 665c3e1897957ea589760edbe2256541a345e928 Danny Yoo committed Aug 1, 2011
Showing with 23 additions and 6 deletions.
  1. +15 −2 compiler/compiler.rkt
  2. +5 −4 logger.rkt
  3. +3 −0 tests/more-tests/simple-functions.rkt
View
@@ -1667,8 +1667,10 @@
;; We should do more here eventually, including things like type inference or flow analysis, so that
;; we can generate better code.
(define (extract-static-knowledge exp cenv)
+ (log-debug (format "Trying to discover information about ~s" exp))
(cond
[(Lam? exp)
+ (log-debug "known to be a lambda")
(make-StaticallyKnownLam (Lam-name exp)
(Lam-entry-label exp)
(if (Lam-rest? exp)
@@ -1677,20 +1679,24 @@
[(and (LocalRef? exp)
(not (LocalRef-unbox? exp)))
(let ([entry (list-ref cenv (LocalRef-depth exp))])
+ (log-debug (format "known to be ~s" entry))
entry)]
[(ToplevelRef? exp)
+ (log-debug (format "toplevel reference of ~a" exp))
(when (ToplevelRef-constant? exp)
(log-debug (format "toplevel reference ~a should be known constant" exp)))
(let: ([name : (U Symbol False GlobalBucket ModuleVariable)
(list-ref (Prefix-names (ensure-prefix (list-ref cenv (ToplevelRef-depth exp))))
(ToplevelRef-pos exp))])
(cond
[(ModuleVariable? name)
+ (log-debug (format "toplevel reference is to ~s" name))
name]
[(GlobalBucket? name)
'?]
[else
+ (log-debug (format "nothing statically known about ~s" exp))
'?]))]
[(Constant? exp)
@@ -1700,6 +1706,7 @@
exp]
[else
+ (log-debug (format "nothing statically known about ~s" exp))
'?]))
@@ -2002,8 +2009,11 @@
(: compile-apply-values (ApplyValues CompileTimeEnvironment Target Linkage -> InstructionSequence))
(define (compile-apply-values exp cenv target linkage)
+ (log-debug (format "apply values ~a" exp))
(let ([on-zero (make-label 'onZero)]
- [after-args-evaluated (make-label 'afterArgsEvaluated)])
+ [after-args-evaluated (make-label 'afterArgsEvaluated)]
+ [consumer-info
+ (extract-static-knowledge (ApplyValues-proc exp) cenv)])
(append-instruction-sequences
;; Save the procedure value temporarily in a control stack frame
@@ -2038,7 +2048,10 @@
(make-instruction-sequence
`(,(make-PopControlFrame)))
- ;; Finally, do the generic call into the function.
+
+ ;; Finally, do the generic call into the consumer function.
+ ;; FIXME: we have more static knowledge here of what the operator is.
+ ;; We can make this faster.
(compile-general-procedure-call cenv (make-Reg 'argcount) target linkage))))
View
@@ -1,5 +1,6 @@
#lang racket/base
-(require racket/match)
+(require racket/match
+ racket/list)
;; A small module to provide logging for Whalesong.
@@ -12,20 +13,20 @@
(define (log-debug message . args)
(log-message whalesong-logger
'debug
- (apply format message args)
+ (if (empty? args) message (apply format message args))
#f))
(define (log-warning message . args)
(log-message whalesong-logger
'warning
- (apply format message args)
+ (if (empty? args) message (apply format message args))
#f))
(define (log-error message . args)
(log-message whalesong-logger
'error
- (apply format message args)
+ (if (empty? args) message (apply format message args))
#f))
@@ -1,4 +1,7 @@
#lang planet dyoo/whalesong
+
+(provide (all-defined-out))
+
(define (f x)
(* x x))

0 comments on commit 665c3e1

Please sign in to comment.