Skip to content
This repository
Browse code

adding the code for analyzing what applications a lambda calls

  • Loading branch information...
commit 956238af05e2f8223af27d2f07463012045d814c 1 parent c74d368
Danny Yoo authored
156 compiler/compiler.rkt
@@ -29,6 +29,12 @@
29 29 compile-general-procedure-call)
30 30
31 31
  32 +;; We keep track of which lambda is currently being compiled for potential optimizations
  33 +;; e.g. self tail calls.
  34 +(: current-lambda-being-compiled (Parameterof (U #f Lam)))
  35 +(define current-lambda-being-compiled (make-parameter #f))
  36 +
  37 +
32 38
33 39
34 40 (: -compile (Expression Target Linkage -> (Listof Statement)))
@@ -66,6 +72,144 @@
66 72
67 73
68 74
  75 +;; Given a lambda body, collect all the applications that exist within
  76 +;; it. We'll use this to determine what procedures can safely be
  77 +;; transformed into primitives.
  78 +(: collect-lam-applications (Lam CompileTimeEnvironment -> (Listof CompileTimeEnvironmentEntry)))
  79 +(define (collect-lam-applications lam cenv)
  80 +
  81 + (let: loop : (Listof CompileTimeEnvironmentEntry)
  82 + ([exp : Expression (Lam-body lam)]
  83 + [cenv : CompileTimeEnvironment cenv]
  84 + [acc : (Listof CompileTimeEnvironmentEntry) '()])
  85 +
  86 + (cond
  87 + [(Top? exp)
  88 + (loop (Top-code exp)
  89 + (cons (Top-prefix exp) cenv)
  90 + acc)]
  91 +
  92 + [(Module? exp)
  93 + (loop (Module-code exp)
  94 + (cons (Module-prefix exp) cenv)
  95 + acc)]
  96 +
  97 + [(Constant? exp)
  98 + acc]
  99 +
  100 + [(LocalRef? exp)
  101 + acc]
  102 +
  103 + [(ToplevelRef? exp)
  104 + acc]
  105 +
  106 + [(ToplevelSet? exp)
  107 + (loop (ToplevelSet-value exp) cenv acc)]
  108 +
  109 + [(Branch? exp)
  110 + (define acc-1 (loop (Branch-predicate exp) cenv acc))
  111 + (define acc-2 (loop (Branch-consequent exp) cenv acc-1))
  112 + (define acc-3 (loop (Branch-alternative exp) cenv acc-2))
  113 + acc-3]
  114 +
  115 + [(Lam? exp)
  116 + acc]
  117 +
  118 + [(CaseLam? exp)
  119 + acc]
  120 +
  121 + [(EmptyClosureReference? exp)
  122 + acc]
  123 +
  124 + [(Seq? exp)
  125 + (foldl (lambda: ([e : Expression]
  126 + [acc : (Listof CompileTimeEnvironmentEntry)])
  127 + (loop e cenv acc))
  128 + acc
  129 + (Seq-actions exp))]
  130 +
  131 + [(Splice? exp)
  132 + (foldl (lambda: ([e : Expression]
  133 + [acc : (Listof CompileTimeEnvironmentEntry)])
  134 + (loop e cenv acc))
  135 + acc
  136 + (Splice-actions exp))]
  137 +
  138 + [(Begin0? exp)
  139 + (foldl (lambda: ([e : Expression]
  140 + [acc : (Listof CompileTimeEnvironmentEntry)])
  141 + (loop e cenv acc))
  142 + acc
  143 + (Begin0-actions exp))]
  144 +
  145 + [(App? exp)
  146 + (define new-cenv
  147 + (append (build-list (length (App-operands exp)) (lambda: ([i : Natural]) '?))
  148 + cenv))
  149 + (foldl (lambda: ([e : Expression]
  150 + [acc : (Listof CompileTimeEnvironmentEntry)])
  151 + (loop e new-cenv acc))
  152 + (cons (extract-static-knowledge (App-operator exp) new-cenv)
  153 + (loop (App-operator exp) new-cenv acc))
  154 + (App-operands exp))]
  155 +
  156 + [(Let1? exp)
  157 + (define acc-1 (loop (Let1-rhs exp) (cons '? cenv) acc))
  158 + (define acc-2 (loop (Let1-body exp)
  159 + (cons (extract-static-knowledge (Let1-rhs exp) (cons '? cenv))
  160 + cenv)
  161 + acc-1))
  162 + acc-2]
  163 +
  164 + [(LetVoid? exp)
  165 + (loop (LetVoid-body exp)
  166 + (append (build-list (LetVoid-count exp) (lambda: ([i : Natural]) '?))
  167 + cenv)
  168 + acc)]
  169 +
  170 + [(InstallValue? exp)
  171 + (loop (InstallValue-body exp) cenv acc)]
  172 +
  173 + [(BoxEnv? exp)
  174 + (loop (BoxEnv-body exp) cenv acc)]
  175 +
  176 + [(LetRec? exp)
  177 + (let ([n (length (LetRec-procs exp))])
  178 + (let ([new-cenv (append (map (lambda: ([p : Lam])
  179 + (extract-static-knowledge
  180 + p
  181 + (append (build-list (length (LetRec-procs exp))
  182 + (lambda: ([i : Natural]) '?))
  183 + (drop cenv n))))
  184 + (LetRec-procs exp))
  185 + (drop cenv n))])
  186 + (loop (LetRec-body exp) new-cenv acc)))]
  187 +
  188 + [(WithContMark? exp)
  189 + (define acc-1 (loop (WithContMark-key exp) cenv acc))
  190 + (define acc-2 (loop (WithContMark-value exp) cenv acc-1))
  191 + (define acc-3 (loop (WithContMark-body exp) cenv acc-2))
  192 + acc-3]
  193 +
  194 + [(ApplyValues? exp)
  195 + (define acc-1 (loop (ApplyValues-proc exp) cenv acc))
  196 + (define acc-2 (loop (ApplyValues-args-expr exp) cenv acc-1))
  197 + acc-2]
  198 +
  199 + [(DefValues? exp)
  200 + (loop (DefValues-rhs exp) cenv acc)]
  201 +
  202 + [(PrimitiveKernelValue? exp)
  203 + acc]
  204 +
  205 + [(VariableReference? exp)
  206 + (loop (VariableReference-toplevel exp) cenv acc)]
  207 +
  208 + [(Require? exp)
  209 + acc])))
  210 +
  211 +
  212 +
69 213 (: collect-all-lambdas-with-bodies (Expression -> (Listof lam+cenv)))
70 214 ;; Finds all the lambdas in the expression.
71 215 (define (collect-all-lambdas-with-bodies exp)
@@ -871,17 +1015,15 @@
871 1015
872 1016
873 1017
874   -;; We keep track of which lambda is currently being compiled for potential optimizations
875   -;; e.g. self tail calls.
876   -(: current-lambda-body-being-compiled (Parameterof (U #f Lam)))
877   -(define current-lambda-body-being-compiled (make-parameter #f))
878 1018
879 1019
880 1020 (: compile-lambda-body (Lam CompileTimeEnvironment -> InstructionSequence))
881 1021 ;; Compiles the body of the lambda in the appropriate environment.
882 1022 ;; Closures will target their value to the 'val register, and use return linkage.
883 1023 (define (compile-lambda-body exp cenv)
884   - (parameterize ([current-lambda-body-being-compiled exp])
  1024 + (parameterize ([current-lambda-being-compiled exp])
  1025 + (define all-applications (collect-lam-applications exp (extract-lambda-cenv exp cenv)))
  1026 +
885 1027 (let: ([maybe-unsplice-rest-argument : InstructionSequence
886 1028 (if (Lam-rest? exp)
887 1029 (make-Perform
@@ -954,8 +1096,7 @@
954 1096 [cenv : CompileTimeEnvironment (lam+cenv-cenv (first exps))])
955 1097 (cond
956 1098 [(Lam? lam)
957   - (append-instruction-sequences (compile-lambda-body lam
958   - cenv)
  1099 + (append-instruction-sequences (compile-lambda-body lam cenv)
959 1100 (compile-lambda-bodies (rest exps)))]
960 1101 [(CaseLam? lam)
961 1102 (append-instruction-sequences
@@ -1754,7 +1895,6 @@
1754 1895 ;; We should do more here eventually, including things like type inference or flow analysis, so that
1755 1896 ;; we can generate better code.
1756 1897 (define (extract-static-knowledge exp cenv)
1757   - ;(log-debug (format "Trying to discover information about ~s" exp))
1758 1898 (cond
1759 1899 [(Lam? exp)
1760 1900 ;(log-debug "known to be a lambda")
1  tests/more-tests/js-binding.expected
... ... @@ -1,7 +1,6 @@
1 1 "plus: "
2 2 7
3 3 "wait for one second: "
4   -#<undefined>
5 4 "minus:"
6 5 239725
7 6 helloworldtesting
5 tests/more-tests/js-binding.rkt
@@ -9,11 +9,12 @@
9 9
10 10 (define raw-sleep
11 11 (js-async-function->procedure
12   - "function(success, fail, n) { setTimeout(success, n); }"))
  12 + "function(success, fail, n) { setTimeout(function() { success(plt.runtime.VOID);}, n); }"))
13 13 (define (sleep n)
14 14 (unless (real? n)
15 15 (raise-type-error 'sleep "real" n))
16   - (void (raw-sleep (inexact->exact (floor (* n 1000))))))
  16 + (raw-sleep (inexact->exact (floor (* n 1000))))
  17 + (void))
17 18
18 19
19 20 "plus: " (js-plus 3 4)
2  version.rkt
@@ -7,4 +7,4 @@
7 7 (provide version)
8 8 (: version String)
9 9
10   -(define version "1.222")
  10 +(define version "1.227")

0 comments on commit 956238a

Please sign in to comment.
Something went wrong with that request. Please try again.