From fd25182d42e711dd60736b489ef0bc15debeb7eb Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Thu, 10 Mar 2011 00:07:42 -0500
Subject: [PATCH] need letrec next

---
 compile.rkt                 | 56 +++++++++++++++++++++++++++----------
 expression-structs.rkt      |  6 +++-
 find-toplevel-variables.rkt | 11 ++++++--
 3 files changed, 54 insertions(+), 19 deletions(-)

diff --git a/compile.rkt b/compile.rkt
index c01fd0c..0f4ea14 100644
--- a/compile.rkt
+++ b/compile.rkt
@@ -47,7 +47,9 @@
                        target
                        linkage)]
     [(App? exp)
-     (compile-application exp cenv target linkage)]))
+     (compile-application exp cenv target linkage)]
+    #;[(Letrec? exp)
+     (compile-letrec exp cenv target linkage)]))
 
 
 
@@ -120,20 +122,7 @@
 (: lexical-environment-pop-depth (CompileTimeEnvironment Linkage -> Natural))
 ;; Computes how much of the environment we need to pop.
 (define (lexical-environment-pop-depth cenv linkage)
-  (length cenv)
-  #;(cond
-    [(empty? cenv)
-     0]
-    [else
-     (let: ([entry : CompileTimeEnvironmentEntry (first cenv)])
-           (cond
-             [(Prefix? entry)
-              (+ 1 (lexical-environment-pop-depth (rest cenv) linkage))]
-             [(symbol? entry)
-              (cond
-              (+ 1 (lexical-environment-pop-depth (rest cenv) linkage)))]
-             [(eq? entry #f)
-              (+ 1 (lexical-environment-pop-depth (rest cenv) linkage))]))]))
+  (length cenv))
 
 
 
@@ -286,6 +275,43 @@
           (compile (Lam-body exp) extended-cenv 'val 'return))))
 
 
+#;(: compile-letrec (Letrec CompileTimeEnvironment Target Linkage -> InstructionSequence))
+#;(define (compile-letrec exp cenv target linkage)
+  (let* ([after-let (make-label 'afterLet)]
+         [let-linkage (if (eq? linkage 'next)
+                          after-let
+                          linkage)]
+         [extended-cenv : CompileTimeEnvironment
+                        (extend-lexical-environment/names
+                         '()
+                         (reverse (Letrec-names exp)))]
+         [lam-codes : (Listof InstructionSequence)
+                    (let: ([n : Natural (length (Letrec-procs exp))])
+                    (map (lambda: ([lam : Lam]
+                                   [target : Target])
+                                  (compile-lambda lam extended-cenv target 'next))
+                         (Letrec-procs exp)
+                         (build-list (length (Letrec-procs exp))
+                                     (lambda: ([i : Natural])
+                                              (make-EnvLexicalReference (- n 1 i))))))]
+         [body-code : InstructionSequence 
+                    (compile (Letrec-body exp) extended-cenv target let-linkage)]
+   (append-instruction-sequences
+    (end-with-linkage let-linkage cenv
+     (make-instruction-sequence `(;; create space for the lambdas
+                                  ,(make-PushEnvironment n)  
+                                  ;; install each one of them in place
+                                  (apply append-instruction-sequences lam-codes)
+                                  ;; mutate each of the lambda's shells so they're correct
+                                  
+                                  ;; evaluate the body
+                                  body-code
+                                  ;; pop the temporary space
+                                  )))
+    after-let))))
+
+         
+
 
 ;; FIXME: I need to implement important special cases.
 ;; 1. We may be able to open-code if the operator is primitive
diff --git a/expression-structs.rkt b/expression-structs.rkt
index fcf2df4..a985928 100644
--- a/expression-structs.rkt
+++ b/expression-structs.rkt
@@ -5,7 +5,7 @@
 
 ;; Expressions
 
-(define-type ExpressionCore (U Top Constant Var Branch Def Lam Seq App))
+(define-type ExpressionCore (U Top Constant Var Branch Def Lam Seq App #;Letrec))
 
 (define-struct: Top ([prefix : Prefix]
                      [code : ExpressionCore]) #:transparent)
@@ -22,6 +22,10 @@
 (define-struct: App ([operator : ExpressionCore]
                      [operands : (Listof ExpressionCore)]) #:transparent)
 
+#;(define-struct: Letrec ([names : (Listof Symbol)]
+                        [procs : (Listof Lam)]
+                        [body : ExpressionCore]))
+
 (: last-exp? ((Listof Expression) -> Boolean))
 (define (last-exp? seq) 
   (null? (cdr seq)))
diff --git a/find-toplevel-variables.rkt b/find-toplevel-variables.rkt
index 7098444..a666586 100644
--- a/find-toplevel-variables.rkt
+++ b/find-toplevel-variables.rkt
@@ -14,8 +14,8 @@
   (define (loop exp)
     (cond
       [(Top? exp)
-       (list-difference (Prefix-names (Top-prefix exp))
-                        (loop (Top-code exp)))]
+       (list-difference (loop (Top-code exp))
+                        (Prefix-names (Top-prefix exp)))]
       [(Constant? exp)
        empty]
             
@@ -39,7 +39,12 @@
       
       [(App? exp)
        (append (loop (App-operator exp))
-               (apply append (map loop (App-operands exp))))]))
+               (apply append (map loop (App-operands exp))))]
+
+      #;[(Letrec? exp)
+       (list-difference (append (apply append (map loop (Letrec-procs exp)))
+                                (loop (Letrec-body exp)))
+                        (Letrec-names exp))]))
   
   (unique/eq? (loop exp)))
   
\ No newline at end of file