- synching scheme/psyntax.*.ss from the psyntax distribution.

scheme/last-revision

@@ -1 +1 @@
-1624
+1625

scheme/psyntax.builders.ss

@@ -141,8 +141,18 @@
                      vars val-exps)
                 (list body-exp)))))))))
   (define build-library-letrec*
-    (lambda (ae vars locs val-exps body-exp)
+    (lambda (ae top? vars locs val-exps body-exp)
-      `(library-letrec* ,(map list vars locs val-exps) ,body-exp)))
+      (if-wants-library-letrec*
+        `(library-letrec* ,(map list vars locs val-exps) ,body-exp)
+        (build-letrec* ae vars val-exps 
+          (if top? 
+              body-exp
+              (build-sequence ae
+                (cons body-exp
+                  (map (lambda (var loc) 
+                         (build-global-assignment ae loc var))
+                     vars locs))))))))
+
 
   )
 

scheme/psyntax.compat.ss

@@ -20,12 +20,35 @@
           make-struct-type read-annotated
           annotation? annotation-expression annotation-source
           annotation-stripped
-          read-library-source-file)
+          read-library-source-file
+          library-version-mismatch-warning
+          file-locator-resolution-error)
   (import 
     (only (ikarus.compiler) eval-core)
     (only (ikarus.reader.annotated) read-library-source-file)
     (ikarus))
 
+  (define (library-version-mismatch-warning name depname filename)
+    (fprintf (current-error-port)
+        "WARNING: library ~s has an inconsistent dependency \
+         on library ~s; file ~s will be recompiled from \
+         source.\n"
+       name depname filename))
+
+    (define (file-locator-resolution-error libname failed-list)
+      (define-condition-type &library-resolution &condition
+         make-library-resolution-condition
+         library-resolution-condition?
+         (library condition-library)
+         (files condition-files))
+      (raise 
+        (condition 
+          (make-error)
+          (make-who-condition 'expander)
+          (make-message-condition
+            "cannot locate library in library-path")
+          (make-library-resolution-condition 
+            libname failed-list))))
 
   (define-syntax define-record
     (syntax-rules ()

scheme/psyntax.config.ss

@@ -21,8 +21,13 @@
 (library (psyntax config)
   (export if-wants-define-record if-wants-define-struct 
           if-wants-case-lambda
-          if-wants-letrec* if-wants-global-defines)
+          if-wants-letrec* if-wants-global-defines
+          if-wants-library-letrec*
+          base-of-interaction-library)
   (import (rnrs))
+
+  (define (base-of-interaction-library) '(ikarus))
+
   (define-syntax define-option
     (syntax-rules ()
       ((_ name #t) 
@@ -34,6 +39,7 @@
          (syntax-rules ()
            ((_ sk fk) fk))))))
   
+
   (define-option if-wants-define-record  #t)
   (define-option if-wants-define-struct  #t)
   ;;; define-record is an ikarus-specific extension.
@@ -61,6 +67,9 @@
   ;;; If the implementation has built-in support for
   ;;; efficient letrec* (ikarus, chez), then this option
   ;;; should be enabled.  Disabling the option expands
-  ;;; (letrec* ([lhs* rhs*] ...) body) into
+  ;;; (letrec* ((lhs* rhs*) ...) body) into
-  ;;; (let ([lhs* #f] ...) (set! lhs* rhs*) ... body)
+  ;;; (let ((lhs* #f) ...) (set! lhs* rhs*) ... body)
+
+  (define-option if-wants-library-letrec* #t)
+
 )

scheme/psyntax.library-manager.ss

@@ -25,8 +25,7 @@
     current-library-expander
     current-library-collection library-path library-extensions
     serialize-all current-precompiled-library-loader)
-  (import (rnrs) (psyntax compat) (rnrs r5rs)
+  (import (rnrs) (psyntax compat) (rnrs r5rs))
-    (only (ikarus) fprintf))
 
   (define (make-collection)
     (let ((set '()))
@@ -132,21 +131,8 @@
                   (failed-list '()))
             (cond
               ((null? ls)
-               (let ()
+               (file-locator-resolution-error x (reverse failed-list)))
-                 (define-condition-type &library-resolution &condition
+              ((null? exts)
-                    make-library-resolution-condition
-                    library-resolution-condition?
-                    (library condition-library)
-                    (files condition-files))
-                 (raise 
-                   (condition 
-                     (make-error)
-                     (make-who-condition 'expander)
-                     (make-message-condition
-                       "cannot locate library in library-path")
-                     (make-library-resolution-condition 
-                       x (reverse failed-list))))))
-              ((null? exts) 
                (f (cdr ls) (library-extensions) failed-list))
               (else
                (let ((name (string-append (car ls) str (car exts))))
@@ -186,51 +172,47 @@
     ((current-precompiled-library-loader)
       filename
       (case-lambda
-        [(id name ver imp* vis* inv* exp-subst exp-env
+        ((id name ver imp* vis* inv* exp-subst exp-env
           visit-proc invoke-proc visible?)
          ;;; make sure all dependencies are met
          ;;; if all is ok, install the library
          ;;; otherwise, return #f so that the
          ;;; library gets recompiled.
-         (let f ([deps (append imp* vis* inv*)])
+         (let f ((deps (append imp* vis* inv*)))
            (cond
-             [(null? deps)
+             ((null? deps)
               (install-library id name ver imp* vis* inv* 
                 exp-subst exp-env visit-proc invoke-proc 
                 #f #f visible? #f)
-              #t]
+              #t)
-             [else
+             (else
-              (let ([d (car deps)]) 
+              (let ((d (car deps))) 
-                (let ([label (car d)] [dname (cadr d)]) 
+                (let ((label (car d)) (dname (cadr d))) 
-                  (let ([l (find-library-by-name dname)]) 
+                  (let ((l (find-library-by-name dname))) 
                     (cond
-                      [(and (library? l) (eq? label (library-id l)))
+                      ((and (library? l) (eq? label (library-id l)))
-                       (f (cdr deps))]
+                       (f (cdr deps)))
-                      [else 
+                      (else 
-                       (fprintf (current-error-port)
+                       (library-version-mismatch-warning name dname filename)
-                          "WARNING: library ~s has an inconsistent dependency \
+                       #f)))))))))
-                           on library ~s; file ~s will be recompiled from \
+        (others #f))))
-                           source.\n"
-                         name dname filename)
-                       #f]))))]))]
-        [others #f])))
 
   (define library-loader
     (make-parameter
       (lambda (x)
         (let ((file-name ((file-locator) x)))
           (cond
-            [(not file-name) 
+            ((not file-name) 
-             (assertion-violation #f "cannot file library" x)]
+             (assertion-violation #f "cannot file library" x))
-            [(try-load-from-file file-name)]
+            ((try-load-from-file file-name))
-            [else 
+            (else 
              ((current-library-expander)
               (read-library-source-file file-name)
               file-name
               (lambda (name)
                 (unless (equal? name x)
                   (assertion-violation 'import
-                    (let-values ([(p e) (open-string-output-port)])
+                    (let-values (((p e) (open-string-output-port)))
                       (display "expected to find library " p)
                       (write x p)
                       (display " in file " p)
@@ -238,7 +220,7 @@
                       (display ", found " p)
                       (write name p)
                       (display " instead" p)
-                      (e))))))])))
+                      (e))))))))))
       (lambda (f)
         (if (procedure? f)
             f
@@ -310,7 +292,7 @@
 
   (define install-library 
     (case-lambda
-      [(id name ver imp* vis* inv* exp-subst exp-env 
+      ((id name ver imp* vis* inv* exp-subst exp-env 
         visit-proc invoke-proc visit-code invoke-code 
         visible? source-file-name)
        (let ((imp-lib* (map find-library-by-spec/die imp*))
@@ -325,7 +307,7 @@
          (let ((lib (make-library id name ver imp-lib* vis-lib* inv-lib* 
                        exp-subst exp-env visit-proc invoke-proc 
                        visit-code invoke-code visible? source-file-name)))
-           (install-library-record lib)))]))
+           (install-library-record lib))))))
 
   (define (imported-label->binding lab)
     (hashtable-ref label->binding-table lab #f))