trying to identify bindings that need boxing for set-bang

compile.rkt

@@ -161,7 +161,6 @@
                        ,(make-AssignImmediateStatement target (make-Const 'ok))))))])))
 
 
-;; FIXME: exercise 5.43
 (: compile-definition (Def CompileTimeEnvironment Target Linkage -> InstructionSequence))
 (define (compile-definition exp cenv target linkage)
   (let* ([var (Def-variable exp)]
@@ -272,6 +271,9 @@
 
 (: compile-application (App CompileTimeEnvironment Target Linkage -> InstructionSequence))
 (define (compile-application exp cenv target linkage) 
+  ;; FIXME: I need to implement important special cases.
+  ;; 1. We may be able to open-code if the operator is primitive
+  ;; 2. We may have a static location to jump to if the operator is lexically scoped.
   (let ([proc-code (compile (App-operator exp) cenv 'proc 'next)]
         [operand-codes (map (lambda: ([operand : Expression])
                               (compile operand cenv 'val 'next))

find-boxed-bindings.rkt

@@ -0,0 +1,68 @@
+#lang typed/racket/base
+(require "typed-structs.rkt"
+         "lexical-env.rkt"
+         "find-toplevel-variables.rkt")
+
+
+(: find-boxed-bindings (Expression -> (HashTable Expression Boolean)))
+;; Collects the list of toplevel variables we need.
+(define (find-boxed-bindings exp)
+  
+  (: ht (HashTable Expression Boolean))
+  (define ht (make-hasheq))
+  
+  (: loop (Expression CompileTimeEnvironment -> 'ok))
+  (define (loop exp cenv)
+    (cond
+      [(Constant? exp)
+       'ok]
+      
+      [(Quote? exp)
+       'ok]
+      
+      [(Var? exp)
+       'ok]
+      
+      [(Assign? exp)
+       (let ([lexical-address
+              (find-variable (Assign-variable exp) cenv)])
+         (cond
+           [(LocalAddress? lexical-address)
+            (hash-set! ht exp #t)
+            'ok]
+           [(PrefixAddress? lexical-address)
+            'ok]))
+       (loop (Assign-value exp) cenv)]
+      
+      [(Def? exp)
+       (loop (Def-value exp) cenv)]
+      
+      [(Branch? exp)
+       (loop (Branch-predicate exp) cenv)
+       (loop (Branch-consequent exp) cenv)
+       (loop (Branch-alternative exp) cenv)
+       'ok]
+      
+      [(Lam? exp)
+       (let ([extended-cenv
+              (extend-lexical-environment cenv (Lam-parameters exp))])
+
+         (for-each (lambda: ([e : Expression]) (loop e extended-cenv))
+                   (Lam-body exp))
+         'ok)]
+
+      
+      [(Seq? exp)
+       (for-each (lambda: ([e : Expression]) (loop e cenv)) (Seq-actions exp))
+       'ok]
+      
+      [(App? exp)
+       (loop (App-operator exp) cenv)
+       (for-each (lambda: ([e : Expression]) (loop e cenv)) (App-operands exp))
+       'ok]))
+  
+  (let*: ([names : (Listof Symbol) (find-toplevel-variables exp)]
+          [cenv : CompileTimeEnvironment (list (make-Prefix names))])
+  
+         (loop exp cenv))
+  ht)

typed-structs.rkt

@@ -4,7 +4,8 @@
 
 ;; Expressions
 
-(define-type Expression (U Constant Quote Var Assign Branch Def Lam Seq App))
+(define-type ExpressionCore (U Constant Quote Var Branch Def Lam Seq App))
+(define-type Expression (U ExpressionCore Assign))
 (define-struct: Constant ([v : Any]) #:transparent)
 (define-struct: Quote ([text : Any]) #:transparent)
 (define-struct: Var ([id : Symbol]) #:transparent)