From b6cf15b4b7a3fb18962e562a70c12aeb10238459 Mon Sep 17 00:00:00 2001
From: Kathy Gray <kathryn.gray@cl.cam.ac.uk>
Date: Thu, 30 Jun 2005 19:22:41 +0000
Subject: [PATCH] Temporarily fixes a recompilation problem

svn: r282
---
 collects/profj/build-info.ss | 22 +++++++++++++++-------
 collects/profj/compile.ss    |  2 +-
 collects/profj/to-scheme.ss  |  2 +-
 3 files changed, 17 insertions(+), 9 deletions(-)

diff --git a/collects/profj/build-info.ss b/collects/profj/build-info.ss
index 367d607d67..2757806ce2 100644
--- a/collects/profj/build-info.ss
+++ b/collects/profj/build-info.ss
@@ -214,7 +214,8 @@
                      ((beginner) ".bjava")
                      ((intermediate) ".ijava")
                      ((advanced) ".ajava")
-                     ((full) ".java")))
+                     ((full) ".java")
+                     ((dynamic-full) ".djava")))
            (file-path (build-path dir (string-append class suffix))))
       (cond
         ((is-import-restricted? class path level) (used-restricted-import class path caller-src))
@@ -240,12 +241,18 @@
          (send type-recs add-to-records 
                class-name
                (lambda () 
-                 (let* ((location (string-append class suffix))
-                        (ast (call-with-input-file file-path (lambda (p) (parse p location (unbox new-level))))))
-                   (send type-recs set-compilation-location location (build-path dir "compiled"))
-                   (build-info ast (unbox new-level) type-recs 'not_look_up)
-                   (send type-recs get-class-record class-name #f (lambda () 'internal-error "Failed to add record"))
-                   )))
+                 (let ((location (string-append class suffix))
+                       (old-dynamic? (dynamic?)))
+                   (when (eq? 'dynamic-full (unbox new-level))
+                     (dynamic? #t) (set-box! new-level 'full))
+                   (let ((ast (call-with-input-file file-path 
+                                (lambda (p) (parse p location (unbox new-level))))))
+                     (send type-recs set-compilation-location location (build-path dir "compiled"))
+                     (build-info ast (unbox new-level) type-recs 'not_look_up)
+                     (send type-recs get-class-record class-name #f 
+                           (lambda () 'internal-error "Failed to add record"))
+                     (dynamic? old-dynamic?)
+                     ))))
          (send type-recs add-require-syntax class-name (build-require-syntax class path dir #t #f)))
         (else (file-error 'file (cons class path) caller-src level)))
       (when add-to-env (send type-recs add-to-env class path loc))
@@ -276,6 +283,7 @@
              (and (file-exists? (build-path path (string-append class suffix)))
                   (set-box! level lang)))))
       (or (exists? ".java" 'full)
+          (exists? ".djava" 'dynamic-full)
           (exists? ".bjava" 'beginner)
           (exists? ".ijava" 'intermediate)
           (exists? ".ajava" 'advanced))))
diff --git a/collects/profj/compile.ss b/collects/profj/compile.ss
index e07d36ff7d..e57c20c509 100644
--- a/collects/profj/compile.ss
+++ b/collects/profj/compile.ss
@@ -36,7 +36,7 @@
          (let-values  (((path-base file dir?) (split-path (path->complete-path (build-path name)))))
            (let ((compiled-path (build-path path-base "compiled" (path-replace-suffix file ".zo")))
                  (type-path (build-path path-base "compiled" (path-replace-suffix file ".jinfo"))))
-             (unless (and (and (file-exists? compiled-path)
+             (unless #f #;(and (and (file-exists? compiled-path)
                               (> (file-or-directory-modify-seconds compiled-path)
                                  (file-or-directory-modify-seconds (build-path name))))
                          (and (file-exists? type-path)
diff --git a/collects/profj/to-scheme.ss b/collects/profj/to-scheme.ss
index 21c637e409..62440110da 100644
--- a/collects/profj/to-scheme.ss
+++ b/collects/profj/to-scheme.ss
@@ -1170,7 +1170,7 @@
   
   ;create-local-names: (list symbol) -> syntax
   (define (create-local-names names)
-    (make-syntax #f  `(define-local-member-name ,@names) #f))
+    (create-syntax #f  `(define-local-member-name ,@names) #f))
   
   ;translate-parents: (list name) -> (list syntax)
   (define (translate-parents extends)