diff --git a/compiler/compiler.rkt b/compiler/compiler.rkt index 870484f..27dd3aa 100644 --- a/compiler/compiler.rkt +++ b/compiler/compiler.rkt @@ -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,9 +1679,11 @@ [(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) @@ -1687,10 +1691,12 @@ (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)))) diff --git a/logger.rkt b/logger.rkt index 33aaee1..c19e989 100644 --- a/logger.rkt +++ b/logger.rkt @@ -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)) diff --git a/tests/more-tests/simple-functions.rkt b/tests/more-tests/simple-functions.rkt index 56afca0..fe62f67 100644 --- a/tests/more-tests/simple-functions.rkt +++ b/tests/more-tests/simple-functions.rkt @@ -1,4 +1,7 @@ #lang planet dyoo/whalesong + +(provide (all-defined-out)) + (define (f x) (* x x))