Add a few missing primitives to FILE-PRIMITIVE-DESCRIPTION.
authorChris Hanson <org/chris-hanson/cph>
Tue, 3 Apr 2007 04:11:33 +0000 (04:11 +0000)
committerChris Hanson <org/chris-hanson/cph>
Tue, 3 Apr 2007 04:11:33 +0000 (04:11 +0000)
v7/src/runtime/uerror.scm

index a8013e7ee93abfe0ced1e3f9a19204134a3302df..259bdaa5d008c93f4e79ec609a1d31bb77069bd4 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: uerror.scm,v 14.55 2007/01/05 21:19:28 cph Exp $
+$Id: uerror.scm,v 14.56 2007/04/03 04:11:33 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -344,10 +344,13 @@ USA.
        (else false)))
 \f
 (define (file-primitive-description primitive)
-  (cond ((eq? primitive (ucode-primitive file-exists? 1))
+  (cond ((or (eq? primitive (ucode-primitive file-exists? 1))
+            (eq? primitive (ucode-primitive file-exists-direct? 1)))
         (values "determine existence of" "file"))
        ((or (eq? primitive (ucode-primitive file-directory? 1))
-            (eq? primitive (ucode-primitive file-soft-link? 1)))
+            (eq? primitive (ucode-primitive file-soft-link? 1))
+            (eq? primitive (ucode-primitive file-type-direct 1))
+            (eq? primitive (ucode-primitive file-type-indirect 1)))
         (values "determine type of" "file"))
        ((or (eq? primitive (ucode-primitive file-open-append-channel 1))
             (eq? primitive (ucode-primitive file-open-input-channel 1))
@@ -789,15 +792,13 @@ USA.
                      ((and (primitive-procedure? operator)
                            (not (null? operands))
                            (string? (car operands)))
-                      (with-values
-                          (lambda ()
-                            (file-primitive-description operator))
-                        (lambda (verb noun)
-                          (if verb
-                              (signal-file-operation
-                               continuation operator operands 0 verb noun
-                               (error-type->string error-type))
-                              (error (make-condition))))))
+                      (receive (verb noun)
+                          (file-primitive-description operator)
+                        (if verb
+                            (signal-file-operation
+                             continuation operator operands 0 verb noun
+                             (error-type->string error-type))
+                            (error (make-condition)))))
                      (else
                       (error (make-condition)))))))))))